我确信您之前已经听过这句话,并且我是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
答案 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