복수 열 어려움 비교하기 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.

나는이 코드 조각이 :

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