【问题标题】:VBA match rows between two sheets with different row indexesVBA 匹配具有不同行索引的两个工作表之间的行
【发布时间】: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?

标签: excel vba match


【解决方案1】:

添加消息框以识别不匹配的键

    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

【讨论】:

  • 这只是为了检查哪些键不匹配?
  • @anon 是的,丢失的记录 2222 显示了吗?
  • 是的,请参阅更新后的问题。它显示在消息框中
  • @anon 自动调整 sheet1 上的列并检查第 3 行
  • 检查第 3 行是什么意思?
猜你喜欢
  • 2020-04-24
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2018-11-25
  • 1970-01-01
  • 2021-06-27
相关资源
最近更新 更多