データがいっぱいの大きなワークシートがある場合は、VBAを使用して国名を取り出すことは可能ですか？

Question

タイトルが示すように、私は大きなデータセットを持っています。列Bには数字のリストが含まれています。各行には、テキストの合併を含むいくつかのセルがあります。いくつかは20のセルで、ランダムな名前と国名があります。明らかに

Sub PullCountries() 
Dim Rng As Range 
Dim i As Long 
i = 1 

Dim LastRow As Long 
LastRow = Range("B1").End(xlDown).Row 

While i <= LastRow 
Set Rng = Range("B" & i) 

If Application.WorksheetFunction.CountIf(Range(Row(i:i), "United States") Then 'this doesn't work at the moment for triggering when these words appear 
"United States".Copy 'not sure how to be specific here 
Rng.Offset(0, -1).paste special 

ElseIf Application.WorksheetFunction.CountIf(Range(Row(i:i), "Canada") Then 
"Canada".Copy 
Rng.Offset(0, -1).paste special 

'My plan was to write a line for the countries that appear most common, then carry out the rest manually. 


Else: i + i = 1 

End If 
Wend 
End Sub 

、ライン「ユナイテッド：私は、私がこれまで持ってunworkingスクリプトがあり、それぞれに表示されますどんな国に引き出し、かつ列A

擬似に貼り付けするためのスクリプトを書きたいです（Row（i：i））がエラーを起こしています。

誰でもこの作品を作成する方法はありますか？

Answer 1

私の提案は、FindAllメソッドを使用することです。 Thisに概要が示されています。

Dim SearchRange As Range, FindWhat As Variant, FoundCells As Range, FoundCell As Range 

FindWhat = Array("Country1","Country2","Country3",etc) 
Set SearchRange = ActiveSheet.Range("B:B") 

For s = LBound(FindWhat) to UBound(FindWhat) 
    Set FoundCells = FindAll(SearchRange:=SearchRange, FindWhat:=FindWhat(s), LookIn:=xlValues,LookAt:=xlWhole, MatchCase:=False) 
    If Not FoundCells Is Nothing Then 
     For each FoundCell In FoundCells 
      FoundCell.Offset(,-1).Value = FoundCell.Value 
     Next 
    End If 
Next s 

私はあなたが配列FindWhatに提供した各値/国名を探して列Bを通じて意志ループ上に書いたコード。国が見つかった各インスタンスについて、国を同じ行のcolumnAに貼り付けます。それぞれの値が見つかった同じ行ではなく、列Aの最初の開いている/上に貼り付けたい場合はお知らせください。それに応じてコードを調整します。あなたが望んでいた2つのうちのどれが私には明らかではありませんでした。私はこれが役立つことを願っています