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行第2行匹配。如果匹配但在行下方不匹配，则对第1行和第2行的第C列中的两个值求和。

我有这段代码：

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

比较多列难度VBA Excel宏

1 个答案: