在一个单元格中查找，替换为不同的单元格 - 仅适用于一个阶段

Question

我正在创建一个工具来帮助翻译用户界面。

我有一张英文短语的清单，在Sheet“Translate”Col A中，我想与英文词组中的英文短语进行比较，在Col A.的“2052简体中文”中找到。当找到匹配时，我想要将图书馆表格Col B中的中文短语复制到“翻译”工作表的B栏。

搜索类似的问题，不同的论坛，我发现下面的子，我适合我的需求：

Sub Replace_From_List() 

Dim cell As Range, rngFind As Range, counter As Long 
Dim RefSheet As String 
Dim ReplaceSheet As String 

RefSheet = "2052 Simplified Chinese" 
ReplaceSheet = "Translate" 

'List of items to search for from Translated phases sheet column A 
With Sheets(RefSheet) 
    Set rngFind = .Range("A1", .Range("A" & Rows.Count).End(xlUp)) 
End With 

For Each cell In rngFind 
    'Search in Sheet containing phases to translate Column A 
    Set Found = Sheets(ReplaceSheet).Range("A:A").Find(What:=cell.Value, _ 
                LookIn:=xlValues, _ 
                LookAt:=xlWhole, _ 
                SearchOrder:=xlByRows, _ 
                MatchCase:=False) 

    If Not Found Is Nothing Then 
     'When a match is found, replace Sheet "Translate" column B with Sheet "2052 Simplified Chinese" Column B 
     'Overwrites formulas 
     Found.Offset(, 1).Value = cell.Offset(, 1).Value 
     counter = counter + 1 
    End If 
Next cell 

MsgBox "Replacements made: " & counter, , "Replacements Complete" 

End Sub 

不过，这似乎只是替换每个短语匹配一次然后移动到下一个短语。我需要它继续搜索整个表格，并在它移到下一个短语之前替换它找到的每个匹配。

您可以在下面的PIC见B3的价值也应该在B4，同样与B18：B21

Results from Replace_From_List() Sub

我认为我需要添加另一个循环或更改我的循环参数来做到这一点，但我不完全确定发生了什么。

我很熟悉C编程，但我几乎是VBA的新手。

Answer 1

你可以使用FindNext方法来搜索值，直到它返回到原来的找到的项目（尽管我必须说我不明白为什么你不能使用VLOOKUP）。

Sub Replace_From_List() 

Dim cell As Range, rngFind As Range, counter As Long 
Dim RefSheet As String 
Dim ReplaceSheet As String 
Dim s As String 

RefSheet = "2052 Simplified Chinese" 
ReplaceSheet = "Translate" 

'List of items to search for from Translated phases sheet column A 
With Sheets(RefSheet) 
    Set rngFind = .Range("A1", .Range("A" & Rows.Count).End(xlUp)) 
End With 

For Each cell In rngFind 
    'Search in Sheet containing phases to translate Column A 
    Set found = Sheets(ReplaceSheet).Range("A:A").Find(What:=cell.Value, _ 
                LookIn:=xlValues, _ 
                LookAt:=xlWhole, _ 
                SearchOrder:=xlByRows, _ 
                MatchCase:=False) 

    If Not found Is Nothing Then 
     'When a match is found, replace Sheet "Translate" column B with Sheet "2052 Simplified Chinese" Column B 
     'Overwrites formulas 
     s = found.Address 
     Do 
      found.Offset(, 1).Value = cell.Offset(, 1).Value 
      counter = counter + 1 
      Set found = Sheets(ReplaceSheet).Range("A:A").FindNext(found) 
     Loop While found.Address <> s 
    End If 
Next cell 

MsgBox "Replacements made: " & counter, , "Replacements Complete" 

End Sub