在一个单元格中查找,replace为不同的单元格 – 仅适用于一个阶段

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

我有一张英文短语的清单,在表格“翻译”中,我想和英文词组的英文短语进行比较,在表A中的“2052简体中文”的翻译库中。当find一个匹配的时候,我想要共同发起中文短语将要复制到“翻译”工作表的栏目B中的库表格B栏。

search不同的论坛类似的问题,我find了我适应我的需要下面的子:

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 

但是,这似乎只能replace每个匹配的短语一次然后移动到下一个短语。 我需要它继续search整个工作表,并replace它find之前它find下一个短语。

您可以在下图中看到,B3中的值也应该在B4中,与B18:B21一样

Replace_From_List()子结果

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

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

您可以使用FindNext方法,它将search值,直到它返回到原来的find的项目(但我必须说,我不明白为什么你不能只使用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