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 エディターを開き、シート 1 (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

マウス ポインターがプロシージャ内のどこかに設定されていることを確認し、MyMacroF5 キーを押してコードを実行します。それはあなたが求めた魔法を行うはずです:-)