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

Question

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

我有4个不同的列的表，2是相同的情况下（NAME和QTY）。目标是比较数量的差异，然而，为了做到这一点。我必须： 1.对数据进行排序 2.按项目匹配数据项目 这对于小表格来说并不是什么大事，但对于10000行来说，这需要我花几天时间来完成。

请帮助我，我很感激。

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

Answer 1

根据您的上述要求，逻辑完全改变，所以我张贴它作为一个不同的答案。

另外在你的“这是精彩的”上面的快照，有一个小小的错误。根据逻辑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 

快照