0

重複の可能性：
別のシートのリストの内容に基づいてExcelのセルをクリア

Excelで、別のシートのリストの内容に基づいてセルをクリアするbonCodigoは、Sheet1のA列から単語を取得するように指定された列と行の範囲を持つVBAマクロスクリプトを使用して、Sheet2列で完全に一致するものとしてそれらを見つけて取得するのに役立ちました掃除されたものが見つかりました。結果はSheet3で生成されます。

これはそれを行うVBAコードです：

Sub matchAndClear()
Dim ws As Worksheet
Dim arrKeys As Variant, arrData As Variant
Dim i As Integer, j As Integer, k As Integer

'-- here we take keys column from Sheet 1 into a 1D array
arrKeys = WorksheetFunction.Transpose(Sheets(1).Range("A1:A38").Value)
'-- here we take to be cleaned-up-range from Sheet 2 into a 2D array
arrData = WorksheetFunction.Transpose(Sheets(2).Range("A1:I100").Value)

'-- here we iterate through each key in keys array searching it in
'-- to-be-cleaned-up array
For i = LBound(arrKeys) To UBound(arrKeys)
    For j = LBound(arrData, 2) To UBound(arrData, 2)
            '-- when there's a match we clear up that element
            If UCase(Trim(arrData(1, j))) = UCase(Trim(arrKeys(i))) Then
                arrData(1, j) = " "
            End If
            '-- when there's a match we clear up that element
            If UCase(Trim(arrData(2, j))) = UCase(Trim(arrKeys(i))) Then
                arrData(2, j) = " "
            End If
    Next j
Next i

'-- replace old data with new data in the sheet 2 :)
Sheets(3).Range("A1").Offset(0, 0).Resize(UBound(arrData, 2), _
UBound(arrData)) = Application.Transpose(arrData)

End Sub

今回は、少し異なるVBAについてサポートが必要です。Sheet1 B列には別の単語リストがあるため、VBAはSheet1 A列で見つかった単語リストの値と一致するセルの内容を見つけてクリアするのではなく、見つかった値（完全に一致する必要があります）をSheet1B列の値に置き換えます。

4

1 に答える 1

1

入力を正しく理解した場合、以下のコードはfromの「ac」を検索し、次のSheet1!A1「hertha」に置き換えますSheet1!B1。

Sub MatchAndReplace()
    Dim ws As Worksheet
    Dim arrKeysA As Variant, arrKeysB As Variant, arrData As Variant
    Dim i As Integer, j As Integer, k As Integer

    '-- here we take keys column A from Sheet 1 into a 1D array
    arrKeysA = WorksheetFunction.Transpose(Sheets(1).Range("A1:A38").Value)
    '-- here we take keys column B from Sheet 1 into a 1D array
    arrKeysB = WorksheetFunction.Transpose(Sheets(1).Range("B1:B38").Value)
    '-- here we take to be replaced range from Sheet 2 into a 2D array
    arrData = WorksheetFunction.Transpose(Sheets(2).Range("A1:I100").Value)

    '-- here we iterate through each key in keys array searching it in
    '-- to-be-replaced array
    For i = LBound(arrKeysA) To UBound(arrKeysA)
        For j = LBound(arrData, 2) To UBound(arrData, 2)
                '-- when there's a match we replace that element
                If UCase(Trim(arrData(1, j))) = UCase(Trim(arrKeysA(i))) Then
                    arrData(1, j) = Trim(arrKeysB(i))
                End If
                '-- when there's a match we replace that element
                If UCase(Trim(arrData(2, j))) = UCase(Trim(arrKeysA(i))) Then
                    arrData(2, j) = Trim(arrKeysB(i))
                End If
        Next j
    Next i

    '-- put new data on the sheet 3
    Sheets(3).Range("A1").Offset(0, 0).Resize(UBound(arrData, 2), _
    UBound(arrData)) = Application.Transpose(arrData)

End Sub

Sheet3のマクロ結果を含むExcelブックの結果は次のとおりです。https ：//www.dropbox.com/s/i8ya0u7j6tjee13/MatchAndReplace.xls

期待どおりでない場合は返信してください。

于 2013-01-16T18:03:32.987 に答える