在一個單元格中查找，替換爲不同的單元格 - 僅適用於一個階段

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