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

Question

我想在第一列的文本中搜索特定的词，当找到它们时，将相邻的列复制并粘贴到其他地方。

我有这段代码，如果文本正是这些词，它可以正常工作，但如果有其他任何东西，它就会失败（即超级合并器）。

我对 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

Answer 1

你要找的叫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* - *

Answer 2

为了获得更健壮的代码，我将您正在检查的“信号”词移动到子开头的数组中。

与要复制的列的列索引和目标索引相同。

这样一来，如果需求发生变化（例如，寻找第四个词等

此外，您应该避免隐式引用单元格。这就是我添加 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

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

How to find, copy a different column and then paste somewhere else with multiple values

excel

vba

find