Question

我想在工作簿中创建一个可用作比较工具的宏。

历史数据将添加到工作表1“历史”中。然后，当前数据将添加到工作表2“新建”中。数据格式完全相同。

宏应该向下看工作表1中的列G（这是一个密钥标识符）以及列O（显示状态）。然后，应将此数据与工作表2中的G和O列进行比较。

如果列G匹配但列O已更改，则应将工作表2“新建”中的整行粘贴到工作表3“结果”中。

实施例

工作表1“历史” - G列，123456789和O列，无效

工作表2“新建” - G列，123456789和O列，有效

由于G列中存在匹配但状态已更改，因此工作表2中的行将粘贴到工作表3“结果”中的下一个空行中

非常感谢任何帮助。我已经玩过将Vlookup和Countif添加到宏中而没有太大的成功。

Answer 1

这可能会给你一个想法，希望它有用。

Sub matchMe()
    Dim wS As Worksheet, wT As Worksheet
    Dim r1 As Range, r2 As Range
    Dim cel1 As Range, cel2 As Range

    Set wS = ThisWorkbook.Worksheets("Sheet1")
    Set wT = ThisWorkbook.Worksheets("Sheet2")

    With wS
        Set r1 = .Range("G1", .Cells(.Rows.Count, .Columns("G:G").Column).End(xlUp))
    End With

    With wT
        Set r2 = .Range("G1", .Cells(.Rows.Count, .Columns("G:G").Column).End(xlUp))
    End With

    On Error Resume Next
    For Each cel1 In r1
        With Application
            Set cel2 = .Index(r2, .Match(cel1.Value, r2, 0)) 'find match in sheet2
            If Err = 0 Then
                If cel1.Offset(, 8) <> cel2.Offset(, 8) Then copyRow cel2 'if difference, copy
            End If
            Err.Clear
        End With
    Next cel1
End Sub

Sub copyRow(cel As Range)
    Dim w As Worksheet, r As Range
    Set w = ThisWorkbook.Worksheets("Sheet3")
    Set r = w.Cells(w.Rows.Count, Columns("G:G").Column).End(xlUp).Offset(1) 'next row
    cel.EntireRow.Copy w.Cells(r.Row, 1)
End Sub

用于比较两个工作表并突出显示更改位置的宏

1 个答案: