如何查找、复制不同的列,然后将多个值粘贴到其他地方

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