web-dev-qa-db-fra.com

Comment comparer deux lignes entières dans une feuille

Je suis nouveau à VBA. J'ai du travail à faire pour améliorer les performances du code VBA. Pour améliorer les performances du code, je dois lire la ligne entière et la comparer à une autre ligne. Est-il possible de faire cela dans VBA? 

Pseudocode:

sheet1_row1=read row1 from sheet1
sheet2_row1=read row1 from sheet2
if sheet1_row1 = sheet2_row1 then
      print "Row contains same value"
else
      print "Row contains diff value"
end if
excelvbaexcel-vba
10
Vicky
Sub checkit()
Dim a As Application
Set a = Application
MsgBox Join(a.Transpose(a.Transpose(ActiveSheet.Rows(1).Value)), Chr(0)) = _
       Join(a.Transpose(a.Transpose(ActiveSheet.Rows(2).Value)), Chr(0))

End Sub

Que se passe-t-il:

  • a est juste un raccourci pour Application afin que le code ci-dessous soit plus facile à lire
  • ActiveSheet.Rows(1).Value renvoie un tableau 2D avec des dimensions (1 à 1, 1 à {nombre de colonnes dans une feuille de calcul})
  • Nous aimerions condenser le tableau ci-dessus en une valeur unique en utilisant Join(), afin de pouvoir le comparer à un tableau différent de la deuxième ligne. Cependant, Join () ne fonctionne que sur les tableaux 1D, nous avons donc exécuté le tableau deux fois via Application.Transpose(). Remarque: si vous compariez des colonnes au lieu de lignes, il vous suffirait d'un seul passage à travers Transpose ().
  • L'application de Join() au tableau nous donne une chaîne unique où les valeurs de cellule d'origine sont séparées par un "caractère null" (Chr(0)): nous sélectionnons cette option car il est peu probable qu'elle soit présente dans les valeurs de cellule elles-mêmes.
  • Après cela, nous avons maintenant deux chaînes régulières faciles à comparer

Remarque: comme l'a souligné Reafidy dans les commentaires, Transpose() ne peut pas gérer les tableaux contenant plus de. 65 000 éléments, vous ne pouvez donc pas utiliser cette approche pour comparer deux colonnes entières dans des versions d'Excel où les feuilles ont plus que ce nombre de lignes (c'est-à-dire toute version non ancienne).

Remarque 2: les performances de cette méthode sont plutôt mauvaises comparées à une boucle utilisée sur un tableau variant de données lues dans la feuille de calcul. Si vous effectuez une comparaison ligne par ligne sur un grand nombre de lignes, l'approche ci-dessus sera beaucoup plus lente.

26
Tim Williams

Pour votre exemple spécifique, voici deux manières ...

Insensible à la casse:

MsgBox [and(1:1=2:2)]

Sensible aux majuscules et minuscules:

MsgBox [and(exact(1:1,2:2))]

...

Vous trouverez ci-dessous des fonctions généralisées permettant de comparer deux plages contiguës.

Insensible à la casse:

Public Function RangesEqual(r1 As Range, r2 As Range) As Boolean
    RangesEqual = Evaluate("and(" & r1.Address & "=" & r2.Address & ")")
End Function

Sensible aux majuscules et minuscules:

Public Function RangesEqual(r1 As Range, r2 As Range) As Boolean
    RangesEqual = Evaluate("and(exact(" & r1.Address & "," & r2.Address & "))")
End Function
9
Excel Hero

OK, cela devrait être assez rapide: interaction minimale entre l'interface utilisateur Excel et VBA (où réside la majeure partie de la lenteur). Suppose que les feuilles de calcul ont des dispositions similaires à partir de $A$1 et que nous allons seulement essayer de faire correspondre la zone commune des UsedRanges pour les deux feuilles:

Public Sub CompareSheets(wks1 As Worksheet, wks2 As Worksheet)

Dim rowsToCompare As Long, colsToCompare As Long    
    rowsToCompare = CheckCount(wks1.UsedRange.Rows.Count, wks2.UsedRange.Rows.Count, "Row")
    colsToCompare = CheckCount(wks1.UsedRange.Columns.Count, wks2.UsedRange.Columns.Count, "Column")    
    CompareRows wks1, wks2, rowsToCompare, colsToCompare

End Sub

Private Function CheckCount(count1 As Long, count2 As Long, which As String) As Long
    If count1 <> count2 Then
        Debug.Print "UsedRange " & which & " counts differ: " _
            & count1 & " <> " & count2
    End If
    CheckCount = count2
    If count1 < count2 Then
        CheckCount = count1
    End If        
End Function

Private Sub CompareRows(wks1 As Worksheet, wks2 As Worksheet, rowCount As Long, colCount As Long)
    Debug.Print "Comparing first " & rowCount & " rows & " & colCount & " columns..."        
Dim arr1, arr2
    arr1 = wks1.Cells(1, 1).Resize(rowCount, colCount).Value
    arr2 = wks2.Cells(1, 1).Resize(rowCount, colCount).Value
Dim rIdx As Long, cIdx As Long    
    For rIdx = LBound(arr1, 1) To UBound(arr1, 1)
        For cIdx = LBound(arr1, 2) To UBound(arr1, 2)
            If arr1(rIdx, cIdx) <> arr2(rIdx, cIdx) Then
                Debug.Print "(" & rIdx & "," & cIdx & "): " & arr1(rIdx, cIdx) & " <> " & arr2(rIdx, cIdx)
            End If
        Next
    Next
End Sub
5
Mike Woodhouse
Match = True

Row1length = Worksheets("Sheet1").Cells(1, Columns.Count).End(xlToLeft).Column
Row2length = Worksheets("Sheet2").Cells(1, Columns.Count).End(xlToLeft).Column

If Row1length <> Row2length Then
    'Not equal
    Match = False
Else
    For i = 1 To Row1length
        If Worksheets("Sheet1").Cells(1, i),Value <> Worksheets("Sheet2").Cells(1, i) Then
            Match = False
            Exit For
        End If
    Next
End If

If Match = True Then
    Debug.Print "match"
Else
    Debug.Print "not match"
End If
1
chiliNUT

Voici un peu de code qui fera deux gammes de vecteurs. Vous pouvez l'exécuter sur deux lignes, deux colonnes.

Ne croyez pas que c'est aussi rapide que la méthode x2 transpose, mais que c'est plus flexible . L'invocation de colonne prend un peu plus longtemps car il y a 1 million d'éléments à comparer!

Option Explicit

Public Sub Test()
    'Check two columns
    Debug.Print DataAreasAreSame(Columns("a"), Columns("b"))
    'Check two rows
    Debug.Print DataAreasAreSame(Rows(1), Rows(2))
End Sub

Public Function DataAreasAreSame(ByVal DataArea1 As Range, ByVal     DataArea2 As Range) As Boolean
    Dim sFormula As String
    sFormula = "=SUM(If(EXACT(" & DataArea1.Address & "," &       DataArea2.Address & ")=TRUE,0,1))"
    If Application.Evaluate(sFormula) = 0 Then DataAreasAreSame = True
End Function
1
PaulG

= Formule EXACT (B2; D2) et faites glisser vers le bas, la meilleure option pour moi.

0
q3kep

Excel 2016 a une fonction intégrée appelée TEXTJOIN

https://support.office.com/en-us/article/textjoin-function-357b449a-ec91-49d0-80c3-0e8fc845691c

En regardant la réponse de @Tim Williams et en utilisant cette nouvelle fonction (qui n’a pas la limite de ligne 65536):

Sub checkit()
    MsgBox WorksheetFunction.TextJoin(Chr(0), False, ActiveSheet.Rows(1).Value) = _
           WorksheetFunction.TextJoin(Chr(0), False, ActiveSheet.Rows(2).Value)
End Sub

Écrit comme une fonction:

Public Function CheckRangeValsEqual(ByVal r1 As Range, ByVal r2 As Range, Optional ByVal strJoinOn As String = vbNullString) As Boolean
    CheckRangeValsEqual = WorksheetFunction.TextJoin(strJoinOn, False, r1.Value) = _
                          WorksheetFunction.TextJoin(strJoinOn, False, r2.Value)
End Function
0
Aye_Aye_Frey

Si vous voulez le faire dans MS Excel, vous pouvez procéder comme suit. 

Par exemple, vous avez une plage de colonnes de chaque ligne de "A" à "F" et vous devez comparer entre ligne 2 et ligne 3 . Pour vérifier la ligne entière et la comparer à une autre ligne, nous pouvons l'indiquer dans la formule dans une nouvelle colonne Résultat et au lieu d'appuyer sur Entrée après avoir tapé la formule, appuyez sur Ctrl + Maj + Entrée . 

=AND(EXACT(A2:F2,A3:F3))

Le résultat seraVRAIs'ils correspondent etFAUXs'ils ne correspondent pas. Vous verrez des accolades autour de votre formule si vous l'avez correctement entrée en tant que formule matricielle. Après cela, faites glisser chaque ligne vers le bas pour que chaque cellule de cette colonne Result obtienne un résultat de comparaison entre cette ligne et la suivante! 

0
Nawshad Rehan Rasha