私はVBAが初めてです。私は、VBA コードのパフォーマンスを改善する仕事を手にしています。コードのパフォーマンスを向上させるには、行全体を読み取って別の行と比較する必要があります。VBAでこれを行う方法はありますか？
擬似コード:
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
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
どうしたの：
aApplication以下のコードを読みやすくするための省略形ですActiveSheet.Rows(1).Value次元を持つ 2 次元配列を返します (1 から 1、1 から {ワークシートの列数})Join()ので、2 行目の別の配列と比較できます。ただし、Join() は 1 次元配列でのみ機能するため、配列を で 2 回実行しApplication.Transpose()ます。注: 行ではなく列を比較する場合は、Transpose() を 1 回通過するだけで済みます。Join()と、元のセル値が "null 文字" ( ) で区切られた単一の文字列が得られますChr(0)。セル値自体に存在する可能性は低いため、これを選択します。注: コメントで Reafidy が指摘したように、Transpose()約 1 個を超える配列は処理できません。65,000 の要素があるため、このアプローチを使用して、シートの行数がこの数を超えるバージョンの Excel (つまり、古いバージョンではないバージョン) で 2 つの列全体を比較することはできません。
注 2: このメソッドは、ワークシートから読み取ったデータのバリアント配列で使用されるループと比較して、パフォーマンスが非常に悪くなります。 多数の行に対して行ごとの比較を行う場合、上記のアプローチははるかに遅くなります。
OK、これはかなり高速なはずです: Excel UI と VBA の間の最小限の対話 (低速の多くが存在する場所)。ワークシートのレイアウトが似ていると仮定し、2 つのシートの の$A$1共通領域のみを一致させようとします。UsedRange
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
2 つのベクトル範囲を実行するコードを次に示します。2 行 2 列に対して実行できます。
x2 転置法ほど高速ではないと思いますが、より柔軟です。比較するアイテムが 100 万個あるため、列の呼び出しに少し時間がかかります。
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
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
=EXACT(B2;D2) 式とドラッグダウン、私にとって最良のオプション。