比较两个数据范围并将整行复制到工作表中 VBA

Question

我在论坛中发现了很多非常相似的问题，但不知何故没有一个符合我的要求。我有两个范围（a 和 b），我想比较它们，如果值不匹配，我想将整行复制到预定义的工作表中。目的是查找与先前编辑相比已更改的行/值。

Dim a, b as range
Dim ws1,ws2,ws3 as worksheet
Dim last_row, last_row2 as integer 'assume last_row =15, last_row2=12
Dim i, j, k as integer
last_row=15
last_row2=12
' the orignal range is not massive, but at 500x 6 not small either
Set a=ws1.range("I5:S"& last_row)
Set b=ws2.range("H2:R"& last_row2)

在处理范围中的每个项目时，我看到了不同的方法，但不知道哪种方法最快/最好（循环或每个）。主要的 if 语句看起来像这样：

'assume i, j are the used as counters running across the range
k = 1
If Not a(i).value=b(j).value then
a(i)EntireRow.copy
ws3.row(k).paste
k = k + 1
end if

解决方案不能基于公式，因为我需要在每次比较后保存 ws3。非常感谢对此的任何帮助。谢谢！

Answer 1

如果您能够利用 Excel Spill Ranges, you can achieve what you want without VBA. Here's a web Excel file 显示第一个 sheet 中的所有行，其中 A 列不等于 b 列。

=FILTER(Sheet1!A:ZZ,Sheet1!A:A<>Sheet1!B:B)

如果需要 VBA，此例程应该有效。它不是处理值的最佳选择（不使用数组），但它完成了它。

Sub listDifferences()
Dim pullWS As Worksheet, pushWS As Worksheet

Set pullWS = Sheets("Sheet1")
Set pushWS = Sheets("Sheet2")

Dim aCell As Range

For Each aCell In Intersect(pullWS.Range("A:A"), pullWS.UsedRange).Cells
    
    If aCell.Value <> aCell.Offset(0, 1).Value Then
        Dim lastRow As Long
        lastRow = pushWS.Cells(Rows.Count, 1).End(xlUp).Row
        pushWS.Rows(lastRow + 1).Value = aCell.EntireRow.Value
    End If
Next aCell

End Sub

Answer 2

这是我最终使用的小 for 循环。感谢您的输入！

For i = 1 To rOutput.Cells.Count
    If Not rOutput.Cells(i) = rBackUp.Cells(i) Then
'    Debug.Print range1.Cells(i)
'    Debug.Print range2.Cells(i)
    rOutput.Cells(i).EntireRow.Copy wsChangeLog.Rows(k)
    
    k = k + 1
    End If
Next i

比较两个数据范围并将整行复制到工作表中 VBA

Compare two data ranges and copy entire row into worksheet VBA

excel

vba

for-loop

compare

range