Excel中找到與在另一片代替基於列表的內容的單元格內容

Question

可能重複：
Excel clear cells based on contents of a list in another sheet

在Excel clear cells based on contents of a list in another sheet bonCodigo幫助我有柱VBA宏腳本行範圍指定爲從Sheet1的A列中獲取單詞，然後在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中，此處顯示另一個單詞列表，因此VBA不應查找並清除與Sheet1 A列中找到的單詞表值匹配的單元格內容，而是將找到的值（需要完全匹配）替換爲Sheet1 B列中的值。

Answer 1

如果我理解正確輸入，下面的代碼將Sheet1!A1發現「AC」和替換它從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 

這裏是導致Excel工作簿與工作表Sheet 3宏觀結果： https://www.dropbox.com/s/i8ya0u7j6tjee13/MatchAndReplace.xls

如果事情不符合預期，請回復。