vba - 根据单元格内容复制到各个列

Question

我是 VBA 新手，我需要创建宏，它会在 A 列中找到包含“测试”、“数据”或“新”的所有单元格，并将所有这些单元格复制到 B 列，从 B2 开始，所有其他单元格应从 C2 开始复制到 C 列。

Answer 1

了解您已经接受了答案，但是如果您要进行大量此类过滤，那么迭代单元格可能会对性能产生负面影响。尝试一个array. 还可以使用LIKE运算符来比较值，这是完美的wildcard operator。将以下代码添加到 VBA 项目模块中。在工作表中添加一个按钮并通过调用子程序button click event。

Option Explicit

Sub filterSpecifics()
Dim rng As Range
Dim lastRow As Long
Dim vArray As Variant
Dim i As Integer

    lastRow = Sheets(3).Cells(Rows.Count, "A").End(xlUp).Row
    Set rng = Sheets(3).Range("A1").Resize(lastRow)
    vArray = WorksheetFunction.Transpose(rng.Value)

    For i = LBound(vArray) To UBound(vArray)
        If Not IsEmpty(vArray(i)) Then
            If Not vArray(i) Like "test*" And _ 
                 Not vArray(i) Like "data*" And Not vArray(i) Like "new*" Then
                vArray(i) = ""  '-- remove the value
            End If
        End If
    Next i

    '-- output the array to the column B
    rng.Offset(0, 1).Resize(UBound(vArray)) = Application.Transpose(vArray)
End Sub

输出：

Answer 2

打开您的 VBA 编辑器并将以下代码粘贴到 Sheet1 中（在 Microsoft Excel 对象下）：

Option Explicit

Sub MyMacro()
Dim iLastRow As Long 
Dim i As Long 
Dim sVal As String

iLastRow = range("A65536").End(xlUp).Row 'get last row in use

For i = 2 To iLastRow 'iterate trough rows from second to last in use
    sVal = range("A" & i).Value
    If sVal = "test" Or sVal = "data" Or sVal = "new" Then
        range("B" & i).Value = sVal
    Else
        If sVal <> "" Then range("C" & i).Value = sVal
    End If

Next i 
End Sub

确保将鼠标指针设置在过程中的某处，MyMacro然后按 F5 以执行代码。它应该能做到你所要求的魔法:-)