複数の列の比較難易度VBA Excelマクロ

Question

列Aの行1が列Bの行1と一致するかどうかを確認しようとしています。一致する場合は列Eの行1と列Eの行2のチェックが必要です。すべて一致した場合は、C列1行の値を表示する必要があります。

列Aの行1が列Bの行1と一致し、行Eの行1が列2の行2と一致する場合は、行2に移動し、列Aの行2と列Aの行2が一致するかどうかを確認しますE行1つのマッチ列E列これはその行1と行の列Cで2つの値を合計し、次に一致しない行の下に一致する場合2.

Iは、コードのこの部分を有する：

Sub DemoNew() 
    Dim dict1 As Object 
    Dim c1 As Variant, k As Variant 
    Dim currWS As Worksheet 
    Dim i As Double, lastRow As Double, tot As Double 
    Dim number1 As Double, number2 As Double, firstRow As Double 

    Set dict1 = CreateObject("Scripting.Dictionary") 
    Set currWS = ThisWorkbook.Sheets("Sheet1") 

    'get last row withh data in Column A 
    lastRow = currWS.Cells(Rows.count, "A").End(xlUp).Row 

    'put unique numbers in Column A in dict1 
    c1 = Range("A2:B" & lastRow) 
    For i = 1 To UBound(c1, 1) 
     If c1(i, 1) <> "" Then 
      'make combination with first 4 characters 
      dict1(Left(c1(i, 1), 4) & "," & Left(c1(i, 2), 4)) = 1 
     End If 
    Next i 

    'loop through all the numbers in column A 
    For Each k In dict1.keys 
     number1 = Split(k, ",")(0) 
     number2 = Split(k, ",")(1) 
     tot = 0 
     firstRow = 0 

     For i = 2 To lastRow 
      If k = Left(currWS.Range("A" & i).Value, 4) & "," & Left(currWS.Range("B" & i).Value, 4) Then 
       If firstRow = 0 Then 
        firstRow = i 
       End If 
       tot = tot + currWS.Range("C" & i).Value 
      End If 
     Next i 
     currWS.Range("D" & firstRow) = tot 
    Next k 
End Sub 

を

私はこれを試した：

If k = Left(currWS.Range("A" & i).Value, 4) & "," & Left(currWS.Range("B" & i).Value, 4) & (currWS.Range("E" & i).value) Then 

しかし、これは私が欲しかったものを作りません。 Example 1

任意の提案：ここ

は、グラフィカルな表現でしょうか？

ありがとうございました

Answer 1

これは必要なのですか？何が起こっている

Sub DemoNew() 
    Dim dict1 As Object 
    Dim c1 As Variant, k As Variant 
    Dim currWS As Worksheet 
    Dim i As Double, lastRow As Double, tot As Double 
    Dim number1 As Double, number2 As Double, firstRow As Double 

    Dim DataArray 

    Set dict1 = CreateObject("Scripting.Dictionary") 
    Set currWS = ThisWorkbook.Sheets("Sheet1") 

    'get last row withh data in Column A 
    lastRow = currWS.Cells(Rows.Count, "A").End(xlUp).Row 

    'put your sheet into an array in memory so that it references faster 
    DataArray = Range("A2:E" & lastRow) 

    'loop through the array per your logic 
    For i = 1 To UBound(DataArray, 1) - 1 
     If DataArray(i, 1) <> "" And DataArray(i, 1) = DataArray(i, 2) And DataArray(i, 5) = DataArray(i + 1, 5) Then 
      tot = tot + DataArray(i, 3) 
     Else 
      DataArray(i, 4) = DataArray(i, 3) 
     End If 
    Next i 
    DataArray(UBound(DataArray, 1), 4) = DataArray(UBound(DataArray, 1), 3) ' last row will never match the next so set the value in D 

    'write modified data back into sheet 
    currWS.Range("A2:E" & lastRow) = DataArray 

    MsgBox ("Tot is: " & tot) 

End Sub