在Excel中使用VBA查找和替换多个值

Question

我正在寻找VBA代码在Excel中运行以查找和替换大量单词。

基本上，它将是一个简单的Excel文件，其中Sheet1包含1列中包含要替换名称的短语（不是整个短语，而是可能由少量词组成的一个名称）。第二个工作表2包含我需要在工作表Sheet1中找到的1个列值（可能有不止一次当值出现在第1列中时）以及包含翻译的列。我不需要Google API，因为名称非常自定义。

我遇到了下面的脚本，但它基本上什么也没做。

Sub ReplaceValues() 

Dim dataSht As Worksheet 
Dim editSht As Worksheet 
Dim dataRange As Range 
Dim dataColumn As Long 
Dim editColumn As Long 
Dim dataEndRow As Long 
Dim editEndRow As Long 

'sheet that holds all the values we want to find 
Set dataSht = Sheet2 

'sheet we want to edit 
Set editSht = Sheet1 

Dim replaceValue As String 

'replace value is empty string 
replaceValue = "" 

'set the column of the data sheet to A 
dataColumn = 1 

'set the colmun of the sheet to edit to A 
editColumn = 5 

dataEndRow = dataSht.Cells(dataSht.Rows.count, dataColumn).End(xlUp).Row 
editEndRow = editSht.Cells(editSht.Rows.count, editColumn).End(xlUp).Row 

'this is the range of the data that we're looking for 
Set dataRange = dataSht.Range(dataSht.Cells(1, dataColumn), 
dataSht.Cells(dataEndRow, dataColumn)) 

Dim count As Long 
Dim val As String 

For i = 1 To editEndRow 

val = editSht.Cells(i, editColumn).Value 

count = Application.WorksheetFunction.CountIf(dataRange, val) 

    If count > 0 And Trim(val) <> "" Then 

    editSht.Cells(i, editColumn).Value = replaceValue 

    End If 

Next i 


End Sub 

Answer 1

因此，正如我所理解的，你需要一本由词典翻译过来的短语列表 - 一个字一个字。下面的脚本应该这样做 - 假设Sheet1包含短语（在第2行的第1列中），Sheet2包含字典（第1列为原始值，第2列为翻译，第2行也为开头）。替换/翻译的短语将出现在Sheet1的第2列中。

首先，在您的原始代码中，vba将自动将Sheet1和Sheet2作为两个未定义的变量，因此没有关于此的警报。您应该使用Worksheets（）集合来指定工作表。

其次，你忘了更改replaceValue的值。实际上，您可以直接将cell.value作为参数放入替换函数中。因此，除非想使其更易读，否则不需要为此设置变量。

最后，如果你想检查是否包含一个单词。使用InStr函数。但是在你的情况下，使用替换函数就足够了。它会将该单词替换为您想要的翻译，如果找不到匹配，它将不会执行任何操作。

Sub btn_Click() 
    Dim cntPhrases As Integer 
    Dim cntDict As Integer 

    Worksheets("Sheet1").Activate 
    cntPhrases = Worksheets("Sheet1").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count - 1 
    cntDict = Worksheets("Sheet2").Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count - 1 
    MsgBox (cntPhrases) 
    Dim i As Integer 
    Dim j As Integer 
    Dim phrase As String 
    Dim org As String 
    Dim rep As String 

    For i = 2 To cntPhrases + 1 
     phrase = Cells(i, 1) 
     For j = 2 To cntDict + 1 
      org = Worksheets("Sheet2").Cells(j, 1) 
      rep = Worksheets("Sheet2").Cells(j, 2) 
      phrase = replace(phrase, org, rep) 
     Next j 
     Cells(i, 2) = phrase 
    Next i 
End Sub 

Answer 2

最后，我能够用一段非常简单的代码完成我所需要的工作。受过训练的人们！

Sub Test() 

Dim Sh1 As Worksheet 
Dim Sh2 As Worksheet 
Dim FndList, x& 


Set Sh1 = Sheets(1) 
Set Sh2 = Sheets(2) 
FndList = Sh2.Cells(1, 1).CurrentRegion 
For x = 1 To UBound(FndList) 
    Sh1.Cells.Replace What:=FndList(x, 1), Replacement:=FndList(x, 2), LookAt:=xlPart 
Next 
End Sub 

Answer 3

你也可以这样做。

Sub main() 

Dim Find_text() As String 
Dim Replace_text() As String 

Dim str As String 

str = "test 150 test 160 test 170 test 200 test 220" 

Find_text = Split("150 160 170 180 190 200 210 220") 
Replace_text = Split("15 16 17 18 19 20 21 22") 

For i = 0 To UBound(Find_text) 
    For j = 0 To UBound(Replace_text) 
     If InStr(str, Find_text(j)) > 0 Then 
      str = Replace(str, Find_text(j), Replace_text(j)) 
     End If 
    Next 
Next 

MsgBox str 

End Sub