首页 文章

Excel根据另一张表中列表的内容查找和替换单元格内容[重复]

提问于
浏览
0

可能重复:Excel根据另一个工作表中列表的内容清除单元格

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 B中,columnt是另一个单词列表,因此VBA不应找到并清除与Sheet1 A列上找到的wordlist值匹配的单元格内容,而是将找到的值(需要完全匹配)替换为Sheet1 B列中的值 .

1 回答

  • 1

    如果我正确理解输入,下面的代码将从 Sheet1!A1 找到"ac"并将其从 Sheet1!B1 替换为"hertha":

    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

    如果不符合预期,请回复 .

相关问题