Question

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

基本上，它将是一个简单的Excel文件，其中Sheet1包含1列中的短语，其中包含要替换的名称（不是整个短语，而是一个可能包含少量单词的名称）。第二张sheet2包含我需要在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

最后，我能够用一段非常简单的代码完成我需要的工作。得到训练有素的人！

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 2

据我所知，你想要一个由字典翻译的短语列表 - 逐字逐句。下面的脚本应该这样做 - 假设Sheet1包含短语（在第2行的第1列中），Sheet2包含字典（原始值为column1，翻译为column2，第2行为on）。替换/翻译的短语将出现在Sheet1的第2列中。

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

其次，您忘记更改replaceValue的值。实际上，您可以将cell.value直接作为参数放入replace函数中。因此，除非您希望使其更具可读性，否则无需为此设置变量。

最后，如果要检查是否包含单词。使用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 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

使用VBA

3 个答案: