Question

我有2组数据必须根据它们共有的一个标识符进行匹配（范围1在Sheet1上，它从A列运行：F，Range2在Sheet3上运行并从A列运行：M ）。两个范围的匹配值将出现在Sheet1的Sheet E和Sheet3的Column 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支持直接工作表和单元格寻址。有关远离依赖选择和激活以实现目标的更多方法，请参阅How to avoid using Select in Excel VBA macros。

从录制的宏创建循环

1 个答案: