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

Posted 2023-03-11

【中文标题】在 for-each 循环中复制动态范围

【英文标题】：Copying dynamic range in for-each loop

【发布时间】：2017-11-28 18:12:42

【问题描述】：

在过去的几周里，我一直在尝试从其他建议中拼凑出一个可靠的 VBA 来完成这项任务，但现在我正在向大家寻求答案。我正在尝试将 ws2 中的一个范围复制到以 ws1 中的值 i 开始的行中，该行的列 A:K 以与 ws1 中的值 i 匹配的值 c 开头。被复制的标准是 1 和 0。它基本上是一个美化的循环 v-lookup，粘贴了一个动态范围。

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

这是我目前所拥有的：

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

【问题讨论】：

你需要指定你想用这段代码实现什么？将单元格从哪个工作表复制到哪里？标准是什么？没有信息就不可能猜出你在做什么，只是一个不起作用的代码

请不要将代码放入 cmets。所有进一步的解释都应使用edit

放在原始问题中

嗨 Shai，我正在尝试将 ws2 中的范围复制到以与 ws1 中的值 i 匹配的值 c 开头的行的 A:K 列到以值开头的行中我在ws1。被复制的标准是 1 和 0。它基本上是一个美化的循环 v 查找。如果您需要更多信息，请告诉我。

嗨，斯科特，感谢您的编辑和耐心等待！我是新来的，所以我还没有完全掌握格式。

对于表 1 中的大多数人来说，这不是真的吗？如果 i.Cells.Value c.Cells.Value 那么。你写的是想要匹配，而不是不匹配。 "与值 i 匹配的值 c"

【参考方案1】：

如果您确实想要匹配项，并且一旦找到匹配项，则退出 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】：

不确定这是否是您的目标。如果您可以通过“选择以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

【讨论】：

请在ws1.Range(Cells(c, "A"), Cells(c, "K")).Select、Selection.Copy 中使用ws1.Range(Cells(c, "A"), Cells(c, "K")).Copy。

我的 ws1.Range 代码行类型不匹配，不确定 (c, "A") 是否可以作为命名约定，因为 c 已经有行和列位置。

请尝试c.Cells.Value 而不是c（见编辑）

【参考方案3】：

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

另外，复制>>粘贴是一行命令，不需要Select或Activate任何东西。

代码

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