比较Excel中的三列并返回差异

时间:2014-07-28 19:24:17

标签: vba excel-vba excel

我确信您之前已经听过这句话,并且我是Excel VBA的新手,并希望就如何执行以下操作寻求帮助。

我有一个包含数字的A列,一个包含名称的B列,以及一个包含A列相同组成数字的C列。列B和C是记录和列A是独立的,将与列C进行比较。示例

Column A      Column B   Column C    OutputColumn MW1   OutputColumn MW2  OutputColumn MW3

1020          MW1        1020          1020              (1020)             (1020)
2020          MW1        3020          (2020)            2020               (2020)
3020          MW2        2020          3020              (3020)              3020
              MW2        3020
              MW3        3020

我需要做的是将A列中的每一行与B列和C列的每个记录集进行比较,并根据B列中使用的名称将信息发送到输出列 - 我需要在求和中显示的是存在的值每个名称,哪些没有 - 括号中的名称不匹配 - 上面的例子解释了我的意思。

我编写代码尝试这样做,但我要么得到错误,缺少值或重复次数过多 - 作为我使用ActiveSheet.Range("LastCellM").Value = val1等命名的旁注,它的命名是找到输入的最后一行的管理器值,并将数据放入指定列的下一行

最初所有设备都在同一个循环中,但我打破了它们认为可能会解决重复问题。我还添加了一个切换列来尝试跟踪已处理的行,但这些行也不起作用。这里没有显示跟踪前一个记录号的想法,这样当它再次循环时它将跳过已处理的记录。

我希望这是足够的信息,也希望它不会太多 - 有人能把我推向正确的方向吗?我是否过度复杂化了这个过程?

Loop and print the FTN's

   For Each a In Range("B2:B4")
         If Trim(a.Value) = "" Then
         Exit For
         End If
         ActiveSheet.Range("LastCellK").Value = a.Value
      Next

  Range("K2:K1000").ClearContents
  Range("M2:M1000").ClearContents
  Range("O2:O1000").ClearContents
  Range("Q2:Q1000").ClearContents
  Range("S2:S1000").ClearContents
  'Loop Through the List of FTN
  Count = 2
  For Each b In Range("B2:B4")
   If Trim(b.Value) = "" Then
     Exit For
   End If

   'Loop Through DeviceName records looking for Device MCW001
    Count = 2
    For Each d In Range("D2:D10")
       val1 = ""
       val1 = Cells(Count, 8).Value
       Checked = ""
       Checked = Cells(Count, 3).Value

       If Trim(d.Value) = "" Then
       Exit For
       End If

       If Checked = "" Then
          If Trim(d.Value) = "MCW001" Then
              If Trim(val1) = Trim(b.Value) Then
                  ActiveSheet.Range("LastCellM").Value = val1
                  Count = Count + 1
                   ActiveSheet.Range("LastCellC").Value = "Y"
                  Exit For
              Else
                  txt = "-" & Trim(b.Value)
                  ActiveSheet.Range("LastCellM").Value = txt
                  Count = Count + 1
                  ActiveSheet.Range("LastCellC").Value = "Y"
                  Exit For
              End If
          Else
              ActiveSheet.Range("LastCellC").Value = "Y"
          End If

        End If
        Count = Count + 1

     Next
  Next

     Count = 2
     Range("C2:C1000").ClearContents
     For Each b In Range("B2:B4")
      If Trim(b.Value) = "" Then
        Exit For
      End If
      Count = 2
       Range("C2:C1000").ClearContents

      'Loop Through DeviceName records looking for Device MCW002
       For Each d In Range("D2:D10")
          val1 = ""
          val1 = Cells(Count, 8).Value
          lastval = ""
          lastval = Cells(Count, 3).Value
          If Trim(d.Value) = "" Then
          Exit For
          End If

          If (Trim(d.Value) = "MCW002") Then
            ActiveSheet.Range("LastCellC").Value = "Y"
           If lastval <> "Y" Then

              ' Add FTN or X accordingly
               If Trim(val1) = Trim(b.Value) Then
                   ActiveSheet.Range("LastCellO").Value = val1
                   Count = Count + 1
                   Exit For
               Else
                   txt = "-" & Trim(b.Value)
                   ActiveSheet.Range("LastCellO").Value = txt
                   Count = Count + 1

                   Exit For
               End If

             End If

          End If
           Count = Count + 1

      Next


     Next

     Count = 2
      Range("C2:C1000").ClearContents
     Range("C2:C1000").ClearContents
     For Each b In Range("B2:B4")
      If Trim(b.Value) = "" Then
        Exit For
      End If
      Count = 2
       Range("C2:C1000").ClearContents

      'Loop Through DeviceName records looking for Device MCW003
       For Each d In Range("D2:D10")
          val1 = ""
          val1 = Cells(Count, 8).Value
          lastval = ""
          lastval = Cells(Count, 3).Value
          If Trim(d.Value) = "" Then
          Exit For
          End If

          If (Trim(d.Value) = "MCW003") Then
             ActiveSheet.Range("LastCellC").Value = "Y"
            If lastval <> "Y" Then

              ' Add FTN or X accordingly
               If Trim(val1) = Trim(b.Value) Then
                   ActiveSheet.Range("LastCellQ").Value = val1

                   Count = Count + 1
                   Exit For
               Else
                   txt = "-" & Trim(b.Value)
                   ActiveSheet.Range("LastCellQ").Value = txt

                   Count = Count + 1
                   Exit For
               End If

             End If

          End If
           Count = Count + 1

      Next


     Next


  End Sub

1 个答案:

答案 0 :(得分:0)

将每列加载到词典,然后使用方法存在检查该列中是否存在该值。

比较两列的示例:

Sub Button1_Click()
    Set gplsBooks = New Dictionary
    Set pegasusBooks = New Dictionary

    Set sheet = ActiveWorkbook.Sheets(1)

    'fill a dictionary with the content of the first column
    Call populateCollection(sheet, 1, 2, pegasusBooks)

    'fill a dictionary with the content of the second column
    Call populateCollection(sheet, 2, 2, gplsBooks)

    'print the values that exist only in the first column
    Call printDifference(sheet, pegasusBooks, gplsBooks, 3, 2)

    'print the values that exist only in the second column
    Call printDifference(sheet, gplsBooks, pegasusBooks, 4, 2)
End Sub

Private Sub populateCollection(ByVal sheet As Worksheet, column As Integer, initialRow As Integer, ByVal list As Dictionary)

    row = initialRow
    Value = sheet.Cells(row, column).Value

    Do While Value <> Empty
        If Not list.Exists(CStr(Value)) Then
            list.Add CStr(Value), CStr(Value)
        End If
        row = row + 1
        Value = sheet.Cells(row, column).Value
    Loop
End Sub

Private Sub printDifference(ByVal sheet As Worksheet, ByVal list1 As Dictionary, ByVal list2 As Dictionary, column As Integer, initialRow As Integer)

    row = initialRow

    For Each Item In list1.items
        If Not list2.Exists(Item) Then
            sheet.Cells(row, column).Value = Item
            row = row + 1
        End If
    Next
End Sub

执行前:

Pegasus_Books Gpls_Books    Only_in_Pegasus     Only_in_Gpls
A               A           
B               B           
C               F
D               G

执行后:

Pegasus_Books Gpls_Books    Only_in_Pegasus     Only_in_Gpls
A               A           C                   F
B               B           D                   G
C               F
D               G