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

Question

我真的不知道如何清楚地解释这一点。请参阅所附图片

​

​

我有一个包含4个不同列的表，其中2个列彼此相同(名称和数量)。然而，我们的目标是比较QTY之间的差异，以便做到这一点。我必须: 1.对数据进行排序2.逐项匹配数据这对于小表来说不是什么大问题，但是有10,000行，我需要几天的时间才能完成。

请帮帮我，我很感激。

我的逻辑是: 1.对前两列(NAME和QTY)进行排序2.对于后两列(NAME和QTY)的每个值，检查它是否与前两列匹配。如果为true，则插入值。3.对于不匹配的值，插入到新行中，并从前两列中的行偏移，而不是后两列中的行

Answer 1

​

​

基于你的上述要求，逻辑完全改变了，因此我将其作为一个不同的答案发布。

另外，在上面的"This is Wonderful“快照中，有一个小错误。根据逻辑，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

Answer 2

这就是你正在尝试的吗？

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

快照

​

​