在 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
循环。
此外,复制>>粘贴是一行命令,不需要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
过去几周我一直在努力从其他建议中拼凑出可靠的 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
循环。
此外,复制>>粘贴是一行命令,不需要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