VBA 搜索条件，如果找到匹配项，将 2 组不同的数据复制并粘贴到新的 table
VBA Search Criteria, If Match found, Copy and Paste 2 different sets of data into a new table
我已经被这个问题困了几个星期了，我正在寻求帮助和指导下一步该怎么做，希望最终能找到解决方案。通过该网站搜索提供了很多很棒的解决方案，但 none 我可以正常工作。
任务：
在 A 和 B 列中搜索位于 K3 和 L4 列中的搜索条件
如果有匹配项，复制粘贴列 D-F 和 N3-P3 到新的 table(K9-P9)
我正在尝试做的事情的视觉截图：
当前代码：
Option Explicit
Dim base_Position, reverse__BaseDirection As Range
Dim searchCol_AB, rangeUnion_Copy, rangeUnion_Paste As Range
Dim Cell As Object
Dim wsSyn As Worksheet
Set wsSyn = Sheets("Syn_Calc")
Set base_Position = wsSyn.Range("K3")
Set reverse__BaseDirection = wsSyn.Range("L4")
searchCol_AB = wsSyn.Range("A3:B100")
Set rangeUnion_Copy = Union(Cells(, 4), Cells(, 5), Cells(, 6))
Set rangeUnion_Paste = Union(Cells(, 11), Cells(, 12), Cells(, 13))
For Each Cell In searchCol_AB
If Cell.Value = UCase(base_Position) And UCase(reverse__BaseDirection) Then
rangeUnion_Copy.Copy rangeUnion_Paste.Address
End If
Next
End Sub
问题：
我不确定我目前拥有的解决方案是否会执行我希望它执行的操作。我认为可能有比使用 Ucase 更好的选择。
现在的直接问题是代码卡在错误“需要对象”上。我似乎不明白为什么会这样。
注意：我还没有包括从 N3:P3 复制数据的代码，因为我无法让第一部分工作。
如有任何帮助，我们将不胜感激。
提前致谢
四月
If Cell.Value = UCase(base_Position) And UCase(reverse__BaseDirection) Then
以上语法错误，但您没有提供足够的信息来提供解决方案，仅提供建议。
'If the text in base_Position equals Cell.Value and the text in reverse__BaseDirection equals Cell.Value
'this is unlikely because Cell.Value probably shouldn't be equal to both
If Cell.Value = UCase(base_Position) And Cell.Value = UCase(reverse__BaseDirection) Then
'If the text in base_Position equals Cell.Value and the text in reverse__BaseDirection equals Cell.Offest(0, 1).Value
'this is likely because Cell.Value equal one and the cell next to it equals the other
If Cell.Value = UCase(base_Position) And Cell.Offset(0, 1).Value = reverse__BaseDirection Then
从你的图像中看不出你需要 UCase reverse__BaseDirection。
无论如何，您可以看到 And 语法如何处理多个比较。
您还应该将 searchCol_AB 设置为范围对象。
Set searchCol_AB = wsSyn.Range("A3:B100")
如果使用 Cell.Offest(0, 1).Value 的第二个解决方案是正确的，那么您只需查看 A 列。Offset 将查看 B 列。
Set searchCol_AB = wsSyn.Range("A3:A100")
为这样的事情全力以赴（见评论）。
Option Explicit
Sub basePositionPairs()
'these only need to be strings, not range objects
Dim base_Position As String, reverse__BaseDirection As String
'you need to specify each one or they end up as default variants
Dim searchCol_AB As Range, rangeUnion_Copy As Range, rangeUnion_Paste As Range
Dim Cell As Range
Dim wsSyn As Worksheet
Set wsSyn = Worksheets("Syn_Calc")
base_Position = UCase(wsSyn.Range("K3").Value)
reverse__BaseDirection = wsSyn.Range("L4").Value
'look through column A and Offset to look at column B
searchCol_AB = wsSyn.Range("A3:A100")
'these full columns will be used with Intersect later
Set rangeUnion_Copy = wsSyn.Range("D:F")
'Start the paste at K9 (only top-left is required)
Set rangeUnion_Paste = wsSyn.Range("K9")
For Each Cell In searchCol_AB
If Cell.Value = base_Position And Cell.Offset(0, 1).Value = reverse__BaseDirection Then
'copy the intersection of the full columns and Cell's row
Intersect(Cell.EntireRow, rangeUnion_Copy).Copy _
Destination:=rangeUnion_Paste
'second copy from N3:P3
wsSyn.Range("N3:P3").Copy _
Destination:=rangeUnion_Paste.Offset(0, 4)
'advance rangeUnion_Paste down one row
Set rangeUnion_Paste = rangeUnion_Paste.Offset(1, 0)
End If
Next
End Sub
请在下面找到您自己的代码，并进行充分注释。抱歉，我还没来得及检查它是否真的可以做你想做的事情，如果它被更正了。
Sub CurrentCode()
Dim wsSyn As Worksheet
' Dim base_Postion, reverse__BaseDirection As Range
Dim base_Position, reverse__BaseDirection As Range
Dim searchCol_AB, rangeUnion_Copy, rangeUnion_Paste As Range
Dim Cell As Object
Set wsSyn = Sheets("Syn_Calc")
' Since base_Position is a variant the line below assigns a range to it.
Set base_Position = wsSyn.Range("K3")
' reverse__BaseDirection is declared as a range.
' Therefore this cariable is assigned a range as well
Set reverse__BaseDirection = wsSyn.Range("L4")
' ==================================================
' The above concept is probably wrong.
' If you wish to search for the values in K3 and L4
' you should have declared both variables as Strings or Variants
' and assigns the respective ranges' Values to them, such
' base_Position = wsSyn.Range("K3").Value
' ==================================================
' searchCol_AB is declared as a Variant and can therefore be assigned anything.
' If you wanted to assign a range to it, the Set statement would be required, like
' Set searchCol_AB = wsSyn.Range("A3:B100")
' since you omit the Set statement VBA will presume that you mean to
' assign the property of wsSyn.Range("A3:B100").
' Since you don't specify which property you mean, VBA will assign
' the default property which is Value.
searchCol_AB = wsSyn.Range("A3:B100")
' ==================================================
' The above facts propbably don't fit your intentions.
' Since searchCol_AB is intended to be searched it should be a range.
' Therefore: Dim searchCol_AB As Range
' and Set searchCol_AB = wsSyn.Range("A3:B100")
' ==================================================
' rangeUnion_Copy is dimensioned as a Variant
' Yes, you can assign a range object to it but why not declare it as a Range?
Set rangeUnion_Copy = Union(Cells(, 4), Cells(, 5), Cells(, 6))
Set rangeUnion_Paste = Union(Cells(, 11), Cells(, 12), Cells(, 13))
' ==================================================
' Cells(, 4) misses the row number.
' VBA will correct the error and insert 1 instead.
' Therefore, Union(Cells(, 4), Cells(, 5), Cells(, 6))
' is equivalent to Union(Cells(1, 4), Cells(1, 5), Cells(1, 6))
' is equivalent to Range("D1:F1")
' Application.Union creates a range consisting of incontiguous cells
' like Union(Cells(1, 4), Cells(1, 6))
' Range("D1:F1") is just a normal range, not a Union.
' you might use Set rangeUnion_Copy = Range(Cells(1, 4), Cells(1, 6))
' if you need to change thr rows in a loop that might look like
' Set rangeUnion_Copy = Range(Cells(R, 4), Cells(R, 6))
' where R is the For ... Next loop counter
' ==================================================
' your code fails on the next line because
' searchCol_AB holds the values of range wsSyn.Range("A3:B100"),
' not the range itself.
For Each Cell In searchCol_AB
' ==================================================
' A range can have many cells.
' the smallest range has a single cell.
' Ergo, a cell is a range.
' True, a range is an object.
' By declaring Cell as an Object you are employing what
' is called "late binding", meaning VBA only finds out
' which kind of object (Range) it is when it is used.
' You might find late binding beyond the scope of your current
' knowledge and therefore declare a range as a range for the time being.
' ==================================================
If Cell.Value = UCase(base_Position) And UCase(reverse__BaseDirection) Then
' base_Position is a variable of variant type to which a range was assigned.
' Therefore base_Position is a range object.
' UCase([Range object]) is impossible.
' Therefore VBA executes UCase([Range_object.Value])
' That gives the result you intend but in a way you didn't understand.
' Better to avoid the use of default properties.
' ==================================================
' If Cell.Value = UCase(base_Position) And UCase(reverse__BaseDirection) Then
' is a common logical error. The correct syntax is
' If Cell.Value = UCase(base_Position) And Cell.Value = UCase(reverse__BaseDirection) Then
' some programmers would add parentheses for better clarity, thus:-
' If (Cell.Value = UCase(base_Position)) And (Cell.Value = UCase(reverse__BaseDirection)) Then
' Note that each expressions is evaluated to True or False.
' ==================================================
' The Copy command requires specification of a Destination cell.
' Destination is either a single cell (better, since less prone to errors)
' or a range of equal size to the copied range.
' It can't be a string, such as rangeUnion_Paste.Address
' (The Address property always holds a String)
rangeUnion_Copy.Copy rangeUnion_Paste.Address
' ==================================================
' The way you have set rangeUnion_Paste it is of equal size
' to rangeUnion_Copy. Therefore either of the following would work.
' rangeUnion_Copy.Copy Destination:= Range(rangeUnion_Paste.Address)
' rangeUnion_Copy.Copy Destination:= rangeUnion_Paste
' rangeUnion_Copy.Copy Destination:= rangeUnion_Paste.Cells(1)
' ==================================================
End If
Next Cell ' better specify which "Next" is called
End Sub
我已经被这个问题困了几个星期了，我正在寻求帮助和指导下一步该怎么做，希望最终能找到解决方案。通过该网站搜索提供了很多很棒的解决方案，但 none 我可以正常工作。
任务：
在 A 和 B 列中搜索位于 K3 和 L4 列中的搜索条件
如果有匹配项，复制粘贴列 D-F 和 N3-P3 到新的 table(K9-P9)
我正在尝试做的事情的视觉截图：
当前代码：
Option Explicit
Dim base_Position, reverse__BaseDirection As Range
Dim searchCol_AB, rangeUnion_Copy, rangeUnion_Paste As Range
Dim Cell As Object
Dim wsSyn As Worksheet
Set wsSyn = Sheets("Syn_Calc")
Set base_Position = wsSyn.Range("K3")
Set reverse__BaseDirection = wsSyn.Range("L4")
searchCol_AB = wsSyn.Range("A3:B100")
Set rangeUnion_Copy = Union(Cells(, 4), Cells(, 5), Cells(, 6))
Set rangeUnion_Paste = Union(Cells(, 11), Cells(, 12), Cells(, 13))
For Each Cell In searchCol_AB
If Cell.Value = UCase(base_Position) And UCase(reverse__BaseDirection) Then
rangeUnion_Copy.Copy rangeUnion_Paste.Address
End If
Next
End Sub
问题：
我不确定我目前拥有的解决方案是否会执行我希望它执行的操作。我认为可能有比使用 Ucase 更好的选择。
现在的直接问题是代码卡在错误“需要对象”上。我似乎不明白为什么会这样。
注意：我还没有包括从 N3:P3 复制数据的代码，因为我无法让第一部分工作。
如有任何帮助，我们将不胜感激。
提前致谢 四月
If Cell.Value = UCase(base_Position) And UCase(reverse__BaseDirection) Then
以上语法错误，但您没有提供足够的信息来提供解决方案，仅提供建议。
'If the text in base_Position equals Cell.Value and the text in reverse__BaseDirection equals Cell.Value
'this is unlikely because Cell.Value probably shouldn't be equal to both
If Cell.Value = UCase(base_Position) And Cell.Value = UCase(reverse__BaseDirection) Then
'If the text in base_Position equals Cell.Value and the text in reverse__BaseDirection equals Cell.Offest(0, 1).Value
'this is likely because Cell.Value equal one and the cell next to it equals the other
If Cell.Value = UCase(base_Position) And Cell.Offset(0, 1).Value = reverse__BaseDirection Then
从你的图像中看不出你需要 UCase reverse__BaseDirection。
无论如何，您可以看到 And 语法如何处理多个比较。
您还应该将 searchCol_AB 设置为范围对象。
Set searchCol_AB = wsSyn.Range("A3:B100")
如果使用 Cell.Offest(0, 1).Value 的第二个解决方案是正确的，那么您只需查看 A 列。Offset 将查看 B 列。
Set searchCol_AB = wsSyn.Range("A3:A100")
为这样的事情全力以赴（见评论）。
Option Explicit
Sub basePositionPairs()
'these only need to be strings, not range objects
Dim base_Position As String, reverse__BaseDirection As String
'you need to specify each one or they end up as default variants
Dim searchCol_AB As Range, rangeUnion_Copy As Range, rangeUnion_Paste As Range
Dim Cell As Range
Dim wsSyn As Worksheet
Set wsSyn = Worksheets("Syn_Calc")
base_Position = UCase(wsSyn.Range("K3").Value)
reverse__BaseDirection = wsSyn.Range("L4").Value
'look through column A and Offset to look at column B
searchCol_AB = wsSyn.Range("A3:A100")
'these full columns will be used with Intersect later
Set rangeUnion_Copy = wsSyn.Range("D:F")
'Start the paste at K9 (only top-left is required)
Set rangeUnion_Paste = wsSyn.Range("K9")
For Each Cell In searchCol_AB
If Cell.Value = base_Position And Cell.Offset(0, 1).Value = reverse__BaseDirection Then
'copy the intersection of the full columns and Cell's row
Intersect(Cell.EntireRow, rangeUnion_Copy).Copy _
Destination:=rangeUnion_Paste
'second copy from N3:P3
wsSyn.Range("N3:P3").Copy _
Destination:=rangeUnion_Paste.Offset(0, 4)
'advance rangeUnion_Paste down one row
Set rangeUnion_Paste = rangeUnion_Paste.Offset(1, 0)
End If
Next
End Sub
请在下面找到您自己的代码，并进行充分注释。抱歉，我还没来得及检查它是否真的可以做你想做的事情，如果它被更正了。
Sub CurrentCode()
Dim wsSyn As Worksheet
' Dim base_Postion, reverse__BaseDirection As Range
Dim base_Position, reverse__BaseDirection As Range
Dim searchCol_AB, rangeUnion_Copy, rangeUnion_Paste As Range
Dim Cell As Object
Set wsSyn = Sheets("Syn_Calc")
' Since base_Position is a variant the line below assigns a range to it.
Set base_Position = wsSyn.Range("K3")
' reverse__BaseDirection is declared as a range.
' Therefore this cariable is assigned a range as well
Set reverse__BaseDirection = wsSyn.Range("L4")
' ==================================================
' The above concept is probably wrong.
' If you wish to search for the values in K3 and L4
' you should have declared both variables as Strings or Variants
' and assigns the respective ranges' Values to them, such
' base_Position = wsSyn.Range("K3").Value
' ==================================================
' searchCol_AB is declared as a Variant and can therefore be assigned anything.
' If you wanted to assign a range to it, the Set statement would be required, like
' Set searchCol_AB = wsSyn.Range("A3:B100")
' since you omit the Set statement VBA will presume that you mean to
' assign the property of wsSyn.Range("A3:B100").
' Since you don't specify which property you mean, VBA will assign
' the default property which is Value.
searchCol_AB = wsSyn.Range("A3:B100")
' ==================================================
' The above facts propbably don't fit your intentions.
' Since searchCol_AB is intended to be searched it should be a range.
' Therefore: Dim searchCol_AB As Range
' and Set searchCol_AB = wsSyn.Range("A3:B100")
' ==================================================
' rangeUnion_Copy is dimensioned as a Variant
' Yes, you can assign a range object to it but why not declare it as a Range?
Set rangeUnion_Copy = Union(Cells(, 4), Cells(, 5), Cells(, 6))
Set rangeUnion_Paste = Union(Cells(, 11), Cells(, 12), Cells(, 13))
' ==================================================
' Cells(, 4) misses the row number.
' VBA will correct the error and insert 1 instead.
' Therefore, Union(Cells(, 4), Cells(, 5), Cells(, 6))
' is equivalent to Union(Cells(1, 4), Cells(1, 5), Cells(1, 6))
' is equivalent to Range("D1:F1")
' Application.Union creates a range consisting of incontiguous cells
' like Union(Cells(1, 4), Cells(1, 6))
' Range("D1:F1") is just a normal range, not a Union.
' you might use Set rangeUnion_Copy = Range(Cells(1, 4), Cells(1, 6))
' if you need to change thr rows in a loop that might look like
' Set rangeUnion_Copy = Range(Cells(R, 4), Cells(R, 6))
' where R is the For ... Next loop counter
' ==================================================
' your code fails on the next line because
' searchCol_AB holds the values of range wsSyn.Range("A3:B100"),
' not the range itself.
For Each Cell In searchCol_AB
' ==================================================
' A range can have many cells.
' the smallest range has a single cell.
' Ergo, a cell is a range.
' True, a range is an object.
' By declaring Cell as an Object you are employing what
' is called "late binding", meaning VBA only finds out
' which kind of object (Range) it is when it is used.
' You might find late binding beyond the scope of your current
' knowledge and therefore declare a range as a range for the time being.
' ==================================================
If Cell.Value = UCase(base_Position) And UCase(reverse__BaseDirection) Then
' base_Position is a variable of variant type to which a range was assigned.
' Therefore base_Position is a range object.
' UCase([Range object]) is impossible.
' Therefore VBA executes UCase([Range_object.Value])
' That gives the result you intend but in a way you didn't understand.
' Better to avoid the use of default properties.
' ==================================================
' If Cell.Value = UCase(base_Position) And UCase(reverse__BaseDirection) Then
' is a common logical error. The correct syntax is
' If Cell.Value = UCase(base_Position) And Cell.Value = UCase(reverse__BaseDirection) Then
' some programmers would add parentheses for better clarity, thus:-
' If (Cell.Value = UCase(base_Position)) And (Cell.Value = UCase(reverse__BaseDirection)) Then
' Note that each expressions is evaluated to True or False.
' ==================================================
' The Copy command requires specification of a Destination cell.
' Destination is either a single cell (better, since less prone to errors)
' or a range of equal size to the copied range.
' It can't be a string, such as rangeUnion_Paste.Address
' (The Address property always holds a String)
rangeUnion_Copy.Copy rangeUnion_Paste.Address
' ==================================================
' The way you have set rangeUnion_Paste it is of equal size
' to rangeUnion_Copy. Therefore either of the following would work.
' rangeUnion_Copy.Copy Destination:= Range(rangeUnion_Paste.Address)
' rangeUnion_Copy.Copy Destination:= rangeUnion_Paste
' rangeUnion_Copy.Copy Destination:= rangeUnion_Paste.Cells(1)
' ==================================================
End If
Next Cell ' better specify which "Next" is called
End Sub