如何查找、复制不同的列,然后将多个值粘贴到其他地方
How to find, copy a different column and then paste somewhere else with multiple values
我想在第一列的文本中搜索特定的词,当找到它们时,将相邻的列复制并粘贴到其他地方。
我有这段代码,如果文本正是这些词,它可以正常工作,但如果有其他任何东西,它就会失败(即超级合并器)。
我对 VBA 还是很陌生,只是调整了一些其他代码来达到这一点。我认为 find 函数是一个很好的方法,但我无法解决如何避免无限循环的问题。如有任何帮助,我们将不胜感激
Sub Test()
Dim lr As Long
Dim r As Long
' Find last row in column A with data
lr = Cells(Rows.Count, "A").End(xlUp).Row
' Loop through all rows in column A
For r = 1 To lr
' Check value on entry
If (Cells(r, "A") = "Super") Or (Cells(r, "A") = "Pension") Or (Cells(r, "A") = "SMSF") Then
' Copy column B and paste in C where found
Cells(r, "B").Select
Selection.Copy
ActiveCell.Offset(0, 1).PasteSpecial
End If
Next r
End Sub
你要找的叫Wildcard string comparision. And you can use VBA's Like operator来实现你的输出
If (Cells(r, "A") Like "Super*") Or (Cells(r, "A") Like "Pension*") Or (Cells(r, "A") Like "SMSF*") Then
Super*
中的*
表示文本应以“Super”开头,后面可以有任何内容。
如果您想在任何地方搜索单元格是否包含“Super”,可以在 Super
的两端使用 *Super*
- *
为了获得更健壮的代码,我将您正在检查的“信号”词移动到子开头的数组中。
与要复制的列的列索引和目标索引相同。
这样一来,如果需求发生变化(例如,寻找第四个词等
此外,您应该避免隐式引用单元格。这就是我添加 ws 变量的原因 - 你必须调整你的 sheet 名称。
另外,我添加了一个通用函数 isInArray
,它采用单元格值加上具有查找值的数组和 returns true 或 false。这里实现了 like
-运算符。
您不需要 select-copy/paste 值 - 您只需将它们写入目标单元格即可:.Cells(r, targetColumnIndex).value = .Cells(r, sourceColumnIndex).value
.
但请注意:如果您有大量数据,将所有内容加载到一个数组中并对其进行处理会更有意义……但这是下一课要学习的 ;-)
Option Explicit
Public Sub copyValues()
Dim arrLookupValues(2) As Variant
arrLookupValues(0) = "Super"
arrLookupValues(1) = "Pension"
arrLookupValues(2) = "SMSF"
Const sourceColumnIndex As Long = 2 'take value from column B
Const targetColumnIndex As Long = 3 'write value to colum C
application.screenupdating = false
Dim lr As Long
Dim r As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") 'adjust this to your needs
With ws
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
For r = 1 To lr
' Check value on entry
If isInArray(.Cells(r, 1).value, arrLookupValues) Then
' write value of column B (2) to C (3)
.Cells(r, targetColumnIndex).value = .Cells(r, sourceColumnIndex).value
End If
Next r
End With
application.screenupdating = true
End Sub
Private Function isInArray(value As Variant, arrLookFor As Variant) As Boolean
Dim i As Long
For i = LBound(arrLookFor) To UBound(arrLookFor)
If value like arrLookFor(i) & "*" Then
isInArray = True
Exit For
End If
Next
End Function
我想在第一列的文本中搜索特定的词,当找到它们时,将相邻的列复制并粘贴到其他地方。
我有这段代码,如果文本正是这些词,它可以正常工作,但如果有其他任何东西,它就会失败(即超级合并器)。
我对 VBA 还是很陌生,只是调整了一些其他代码来达到这一点。我认为 find 函数是一个很好的方法,但我无法解决如何避免无限循环的问题。如有任何帮助,我们将不胜感激
Sub Test()
Dim lr As Long
Dim r As Long
' Find last row in column A with data
lr = Cells(Rows.Count, "A").End(xlUp).Row
' Loop through all rows in column A
For r = 1 To lr
' Check value on entry
If (Cells(r, "A") = "Super") Or (Cells(r, "A") = "Pension") Or (Cells(r, "A") = "SMSF") Then
' Copy column B and paste in C where found
Cells(r, "B").Select
Selection.Copy
ActiveCell.Offset(0, 1).PasteSpecial
End If
Next r
End Sub
你要找的叫Wildcard string comparision. And you can use VBA's Like operator来实现你的输出
If (Cells(r, "A") Like "Super*") Or (Cells(r, "A") Like "Pension*") Or (Cells(r, "A") Like "SMSF*") Then
Super*
中的*
表示文本应以“Super”开头,后面可以有任何内容。
如果您想在任何地方搜索单元格是否包含“Super”,可以在 Super
*Super*
- *
为了获得更健壮的代码,我将您正在检查的“信号”词移动到子开头的数组中。
与要复制的列的列索引和目标索引相同。
这样一来,如果需求发生变化(例如,寻找第四个词等
此外,您应该避免隐式引用单元格。这就是我添加 ws 变量的原因 - 你必须调整你的 sheet 名称。
另外,我添加了一个通用函数 isInArray
,它采用单元格值加上具有查找值的数组和 returns true 或 false。这里实现了 like
-运算符。
您不需要 select-copy/paste 值 - 您只需将它们写入目标单元格即可:.Cells(r, targetColumnIndex).value = .Cells(r, sourceColumnIndex).value
.
但请注意:如果您有大量数据,将所有内容加载到一个数组中并对其进行处理会更有意义……但这是下一课要学习的 ;-)
Option Explicit
Public Sub copyValues()
Dim arrLookupValues(2) As Variant
arrLookupValues(0) = "Super"
arrLookupValues(1) = "Pension"
arrLookupValues(2) = "SMSF"
Const sourceColumnIndex As Long = 2 'take value from column B
Const targetColumnIndex As Long = 3 'write value to colum C
application.screenupdating = false
Dim lr As Long
Dim r As Long
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") 'adjust this to your needs
With ws
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
For r = 1 To lr
' Check value on entry
If isInArray(.Cells(r, 1).value, arrLookupValues) Then
' write value of column B (2) to C (3)
.Cells(r, targetColumnIndex).value = .Cells(r, sourceColumnIndex).value
End If
Next r
End With
application.screenupdating = true
End Sub
Private Function isInArray(value As Variant, arrLookFor As Variant) As Boolean
Dim i As Long
For i = LBound(arrLookFor) To UBound(arrLookFor)
If value like arrLookFor(i) & "*" Then
isInArray = True
Exit For
End If
Next
End Function