在for-each循环中复制动态范围

Question

为了完成这项任务，我花了几周时间试图从其他建议中拼凑出一个完整的VBA，但现在我要向大家寻求答案。我试图从ws2中的a：K列中复制一个范围，该行以值c开头，该值与ws1中的值I匹配，该行以ws1中的值I开头。正在复制的条件是1和0。它基本上是一个美化的循环v形查找，粘贴动态范围。

我弄清楚了循环机制，现在我只需要帮助编写代码来复制选定的单元格。

这是我到目前为止所拥有的：

For Each i In ws1.Range("A4:A26")
    For Each c In ws2.Range("A8:A28")
        If i.Cells.Value <> c.Cells.Value Then
            'select columns A:K in the row with the value c in ws2
            'open ws1
            'paste selection to[starting at] column D in ws1
            Exit For

        End If
    Next c
Next i

Answer 1

当比较2个工作表中2列中的值时，您有Application. Match函数。不是有两个耗时的For循环，您可以有一个For并使用Application。匹配而不是另一个。

同时，复制

代码

Option Explicit

Sub CompareColumns()

Dim ws1 As Worksheet
Dim ws2 As Worksheet

Dim MatchRng As Range, C As Range
Dim MatchRow As Long

Set ws1 = Worksheets("Sheet1") ' change "Sheet1" to your sheet's name
Set ws2 = Worksheets("Sheet2") ' change "Sheet2" to your sheet's name

' set the matched range
Set MatchRng = ws1.Range("A4:A26")

With ws2
    For Each C In .Range("A8:A28")
        ' use Match to see if there's a match
        If Not IsError(Application.Match(C.Value, MatchRng, 0)) Then
            MatchRow = Application.Match(C.Value, MatchRng, 0) + MatchRng.Row - 1 ' get the row of the match (add 4 since the range starts at row 4)

            ' copy >> paste is a 1-line command
            .Range(.Cells(C.Row, "A"), .Cells(C.Row, "K")).Copy Destination:=ws1.Range("D" & MatchRow)
        End If
    Next C
End With

End Sub

Answer 2

不确定这是否是您的目标。如果您可以澄清“选择以ws1中的值c开头的行、列A： K”的含义，那可能会有所帮助。我假设Exit For是如果值不匹配，则您希望在执行IF语句中的所有操作后转到下一个i。

使用记录宏功能可能会有所帮助。

For Each i In ws1.Range("A4:A26")
    For Each c In ws2.Range("A8:A28")
        If i.Cells.Value <> c.Cells.Value Then
            'select the row, columns A:K that starts with the value c in ws2
            ws2.Range(Cells(c.Cells.Value, "A"), Cells(c.Cells.Value, "K")).Copy
            'open ws1
            ws1.Activate
            'paste selection, starting from column D in ws1, into ws1
            ws1.Cells(i.Cells.Value, "D").Select
            ActiveSheet.Paste
            Exit For
        End If
    Next c
Next i
End Sub

Answer 3

如果您真的想要匹配项，并且一旦找到匹配项，则退出For。
这无需激活或选择即可完成

     For Each i In ws1.Range("A4:A26")
         For Each c In ws2.Range("A8:A28")
             If i.Value = c.Value Then
                 'select the row, columns A:K that starts with the value c in ws2
                 ws2.Range("A" & c.Row & ":K" & c.Row).Copy ws1.Range("A" & i.Row)
                 Exit For
             End If
         Next c 
     Next i