如何匹配列之间的数据以进行比较

Question

我真的不知道如何以清晰的方式解释这一点。请参阅附图

我有一个包含4个不同列的表，2个彼此相同（NAME和QTY）。然而，目标是比较QTY之间的差异，以便做到这一点。我必须： 1.对数据进行排序 2.逐项匹配数据 这对于小桌子来说并不是什么大问题，但是有一万行，我需要几天的时间来完成它。

请帮助我，我很感激。

我的逻辑是： 1.排序前两列（NAME和QTY） 2.对于后两列（NAME和QTY）的每个值，检查它是否与前两列匹配。如果为true，则插入值。 3.对于不匹配的值，插入到与前两列但不在后两列中的行偏移的新行

Answer 1

这是你在尝试的吗？

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, newRow As Long
    Dim aCell As Range, SrchRange As Range

    Set ws = Sheets("Sheet1")

    With ws
        .Columns("A:B").Copy .Columns("G:G")
        .Columns("G:H").Sort Key1:=.Range("G2"), Order1:=xlAscending, Header:=xlYes, _
          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
          DataOption1:=xlSortNormal

        lastRow = .Range("G" & Rows.Count).End(xlUp).Row
        newRow = lastRow

        Set SrchRange = .Range("G2:G" & lastRow)

        lastRow = .Range("C" & Rows.Count).End(xlUp).Row

        .Range("I1").Value = "NAME": .Range("J1").Value = "QTY"

        For i = 2 To lastRow
            If Len(Trim(.Range("C" & i).Value)) <> 0 Then
                Set aCell = SrchRange.Find(What:=.Range("C" & i).Value, LookIn:=xlFormulas, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

                If Not aCell Is Nothing Then
                    .Range("I" & aCell.Row).Value = .Range("C" & i).Value
                    .Range("J" & aCell.Row).Value = .Range("D" & i).Value
                Else
                    newRow = newRow + 1
                    .Range("I" & newRow).Value = .Range("C" & i).Value
                    .Range("J" & newRow).Value = .Range("D" & i).Value
                End If
            End If
        Next
    End With
End Sub

<强>快照

Answer 2

根据您的上述要求，逻辑完全改变，因此我将其作为不同的答案发布。

同样在你的＆＃34; 这是精彩的＆＃34;快照上面，有一个小错误。根据逻辑SAMPLE10不能超过SAMPLE11。它必须在SAMPLE11之后。

见下面的快照

以下是代码：）

Option Explicit

Sub sAMPLE()
    Dim ws As Worksheet
    Dim lastRow As Long, i As Long, newRow As Long, rw As Long
    Dim aCell As Range, SrchRange As Range

    Set ws = Sheets("Sheet1")

    With ws
        .Columns("A:B").Copy .Columns("G:G")
         .Columns("G:H").Sort key1:=.Range("G2"), Order1:=xlAscending, Header:=xlYes, _
          OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
          DataOption1:=xlSortNormal

        .Columns("H:H").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

         lastRow = .Range("G" & Rows.Count).End(xlUp).Row

         For i = 2 To lastRow
            .Range("H" & i).Value = GetLastNumbers(.Range("G" & i).Value)

            If .Range("H" & i).Value <> 0 Then
                .Range("G" & i).Value = Left(.Range("G" & i).Value, _
                Len(.Range("G" & i).Value) - Len(.Range("H" & i).Value))
            End If
         Next i

        .Columns("G:H").Sort key1:=.Range("H2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

        For i = 2 To lastRow
            If .Range("H" & i).Value <> 0 Then _
            .Range("G" & i).Value = .Range("G" & i).Value & .Range("H" & i).Value
        Next i

        .Columns("H:H").Delete

        newRow = lastRow

        Set SrchRange = .Range("G2:G" & lastRow)

        lastRow = .Range("C" & Rows.Count).End(xlUp).Row

        .Range("I1").Value = "NAME": .Range("J1").Value = "QTY"

        For i = 2 To lastRow
            If Len(Trim(.Range("C" & i).Value)) <> 0 Then
                Set aCell = SrchRange.Find(What:=.Range("C" & i).Value, LookIn:=xlFormulas, _
                LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

                If Not aCell Is Nothing Then
                    .Range("I" & aCell.Row).Value = .Range("C" & i).Value
                    .Range("J" & aCell.Row).Value = Application.Evaluate("=SUMPRODUCT((C2:C" & lastRow _
                            & "=" & """" & .Range("C" & i).Value & """" & ")*(D2:D" & lastRow & "))")
                Else
                    newRow = newRow + 1
                    .Range("I" & newRow).Value = .Range("C" & i).Value
                    .Range("J" & newRow).Value = .Range("D" & i).Value
                End If
            End If
        Next
        lastRow = .Range("G" & Rows.Count).End(xlUp).Row
        For i = lastRow To 2 Step -1
            If .Range("G" & i).Value = .Range("G" & i - 1).Value Then
                .Range("H" & i - 1).Value = .Range("H" & i).Value + .Range("H" & i - 1).Value
                If Application.WorksheetFunction.CountA(.Range("I" & i & ":J" & i)) = 0 Then
                    .Range("G" & i & ":J" & i).Delete Shift:=xlUp
                Else
                    .Range("G" & i & ":H" & i).Delete Shift:=xlUp
                End If
            End If
        Next i

        lastRow = .Range("I" & Rows.Count).End(xlUp).Row
        newRow = .Range("G" & Rows.Count).End(xlUp).Row

        If lastRow <= newRow Then Exit Sub

        .Range("I" & newRow & ":J" & lastRow).Sort key1:=.Range("I" & newRow), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal

        For i = lastRow To newRow Step -1
            If .Range("I" & i).Value = .Range("I" & i - 1).Value Then
                .Range("J" & i - 1).Value = .Range("J" & i).Value + .Range("J" & i - 1).Value
                .Range("I" & i & ":J" & i).Delete Shift:=xlUp
            End If
        Next i
    End With
End Sub

Function GetLastNumbers(strVal As String) As Long
    Dim j As Long, strTemp As String

    For j = Len(strVal) To 1 Step -1
        If Not IsNumeric(Mid(strVal, j, 1)) Then Exit For
        strTemp = Mid(strVal, j, 1) & strTemp
    Next j
    GetLastNumbers = Val(Trim(strTemp))
End Function