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

Copying dynamic range in for-each loop

过去几周我一直在努力从其他建议中拼凑出可靠的 VBA 来完成这项任务,但现在我要向大家寻求答案。我正在尝试将范围从 ws2,以与 ws1 中的值 i 匹配的值 c 开头的行的列 A:K 复制到以 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

不确定这是否是您的目标。如果您能阐明 "select the row, columns A:K that starts with the value c in ws1" 的含义,那可能会有所帮助。我假设 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

如果您真的想要匹配项,并且一旦找到匹配项,则退出 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 

比较 2 个工作表中 2 列的值时,您有 Application.Match 函数。您可以使用一个 For 并使用 Application.Match 而不是另一个

,而不是使用两个非常耗时的 For 循环。

此外,复制>>粘贴是一行命令,不需要SelectActivate 随便什么。

代码

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