从录制的宏创建循环

Question

我有 2 组数据必须根据它们共有的一个标识符进行匹配（范围 1 在 Sheet1 上，它从第 A:F 列运行，Range2 在 Sheet3 上，并从列 A:M）。运行ge 的匹配值将出现在 Sheet1 的 E 列和 Sheet3 的 C 列中。我试图记录一个宏，看看我是否可以创建一个简单的循环来重复我正在做的事情，直到它运行到任何不规则数据中，但我运行进入了如何循环操作的问题我正在做的。这是我的代码：

Sub Record_And_Destroy() 
    'first issue is writing a loop that will cycle through all rows in column E
    'starting in row 18 in this example
    Range("E18").Select
    Selection.Copy
    Sheets("Sheet3").Select
    'Sheet3 contains the second table of data 
    'I want to search based on the copied value from Sheet1...
    *Cells.Find(What:="03885740-131601", After:=ActiveCell, LookIn:=xlFormulas _
        , LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate*
    'The data that is being matched is in column C of Sheet3 but I need all columns A:M that
    'are associated with the found match
    Range("A10:M10").Select
    Application.CutCopyMode = False
    Selection.Cut
    Sheets("Sheet1").Select
    Range("G18").Select
    'Column G is the next available column when matching to Sheet1 so every other selection
    'would be placed in Column G but the row would differ based upon
    'which row was being searched
    ActiveSheet.Paste
    Sheets("Sheet3").Select
    Selection.Delete Shift:=xlUp
    'this way I clean up the data base to only contain the "problem" cases
End Sub

问题 1：有没有办法使用 Cells.Find 来搜索选择而不是值？

问题 2：如果循环找不到匹配项，有没有办法将 Sheet1 上的行 G:S 格式化为显示红色背景，以便我知道返回并检查这些值一次循环结束了吗？

Answer 1

据我了解，您想向下查看 E 列（从第 18 行开始）并搜索每个值以查看它是否存在于 Sheet3 的 C 列中。如果存在，则将 Sheet3 上的该行从 A 列复制到M 列并将其放入 Sheet1，从当前正在检查的同一行的 G 列开始。

Sub Record_And_Destroy()
    Dim rw As Long, mrw As Long, ws3 As Worksheet

    Set ws3 = Sheets("Sheet3")

    With Sheets("Sheet1")
        For rw = 18 To .Cells(Rows.Count, "E").End(xlUp).Row
            If CBool(Application.CountIf(ws3.Columns(3), .Cells(rw, "E").Value)) Then
                mrw = Application.Match(.Cells(rw, "E"), ws3.Columns(3), 0)
                ws3.Cells(mrw, "A").Resize(1, 13).Copy _
                  Destination:=.Cells(rw, "G")
                ws3.Rows(mrw).EntireRow.Delete
            End If
        Next rw
    End With

    Set ws3 = Nothing

End Sub

请注意，我已完全避免使用 .Select 以支持直接工作表和单元格寻址。有关摆脱依赖 select 并激活以实现目标的更多方法，请参阅 How to avoid using Select in Excel VBA macros。

从录制的宏创建循环

Creating a Loop from a Recorded Macro

excel

vba

find