VBA 地名を抽出し、セルごとに分ける3

質問

https://okwave.jp/qa/q9700177.html
上記は地名を抽出し、「抽出」シートのA2から分けるように並べるといったマクロを実行しています。
A列　　B列　　C列　　D列　　E列
地名　　空白　　地名　　空白　　地名
といった一つの列を飛ばして並べたいです。
下記がイメージ画像です。
宜しくお願いします。

回答No.1

kkkkkm · ベストアンサー

前回のままで範囲をK1まで広げたらいけると思いますが、コードの位置関係などの部分も多少変更しました。

Sub Test()
Dim i As Long, mCol As Variant
Dim FStr As String, tmp As String
Dim mRange As Range, mFR As Range

With Sheets("抽出")
Set mFR = .Range("A1:K1")
For i = 2 To Cells(Rows.Count, "G").End(xlUp).Row
If Cells(i, "G").Value <> "" Then
tmp = Split(Cells(i, "G"), "(")(1)
FStr = Left(tmp, Len(tmp) - 1)
Set mRange = mFR.Find(FStr, LookAt:=xlWhole)
If mRange Is Nothing Then
MsgBox "都市が存在しません。　" & Cells(i, "G").Value, vbInformation
Else
mCol = mRange.Column
.Cells(.Cells(Rows.Count, mCol).End(xlUp).Row + 1, mCol).Value = Cells(i, "G").Value
Set mRange = Nothing
End If
End If
Next
Set mFR = Nothing
End With
End Sub

お礼

いつもありがとうございます。
おかげさまでできました。