【发布时间】:2021-10-29 13:37:59
【问题描述】:
我有一个代码可以匹配两张表中的行,并将匹配的行粘贴到 sheet3 中,将不匹配的行粘贴到 sheet4 中。当 sheet1 中的第一行与 sheet2 中的第一行匹配时,会出现正确的输出。问题是有差异的行没有显示在 sheet4 中
谁能帮帮我,我在哪里做错了?我想要一个与行匹配的代码,无论它们具有哪个行索引。它可能因每个输入而异。
我的代码是:
Sub MatchRows()
Dim a As Variant, b As Variant, c As Variant, d As Variant
Dim i As Long, j As Long, k As Long, m As Long, n As Long
Dim dic As Object, ky As String
Set dic = CreateObject("Scripting.Dictionary")
a = Sheets("Sheet1").Range("A2:I" & Sheets("Sheet1").Range("H" & Rows.Count).End(3).Row).Value
b = Sheets("Sheet2").Range("A2:I" & Sheets("Sheet2").Range("H" & Rows.Count).End(3).Row).Value
ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
ReDim d(1 To UBound(a, 1), 1 To UBound(a, 2))
For i = 1 To UBound(b, 1)
ky = b(i, 3) & "|" & b(i, 4) & "|" & b(i, 5) & "|" & b(i, 9)
dic(ky) = i
Next
For i = 1 To UBound(a, 1)
ky = a(i, 3) & "|" & a(i, 4) & "|" & a(i, 5) & "|" & a(i, 9)
If dic.exists(ky) Then
j = dic(ky)
If a(i, 8) = b(j, 8) Then
k = k + 1
For n = 1 To UBound(a, 2)
c(k, n) = a(i, n)
Next
c(k, 8) = 0
Else
m = m + 1
For n = 1 To UBound(a, 2)
d(m, n) = a(i, n)
Next
d(m, 8) = a(i, 8) - b(j, 8)
End If
Else
MsgBox "'" & ky & "' not matched on row " & i + 1
End If
Next
If k > 0 Then Sheets("Sheet3").Range("A" & Rows.Count).End(3)(2).Resize(k, UBound(a, 2)).Value = c
If m > 0 Then Sheets("Sheet4").Range("A" & Rows.Count).End(3)(2).Resize(m, UBound(a, 2)).Value = d
End Sub
尽管它们位于 sheet1 和 sheet2 中的不同行索引上,但这些行匹配,这很好。现在的问题是存在差异的行没有显示在 sheet4(差异表)中
【问题讨论】:
-
在第二个循环中,ky 应该从
a而非b构建。ky = a(i, 1) & "|" & a(i, 2) etc -
啊,太好了,谢谢!会尝试,希望它有效
-
@CDP1802 好的,现在我计算匹配的正确行,尽管它们位于不同的行上。但是现在没有粘贴到应该说明差异的工作表中的行?它只是空的
-
查看更新的代码。它不会将任何有差异的行复制到 sheet4(差异表)中。这是为什么呢?
-
为什么你将键列从 3,4,5,9 (上一个问题的 C,D,E,I)改为现在的 1,2,4,6,7?