人力検索はてな
モバイル版を表示しています。PC版はこちら
i-mobile

住所録を作成しています。以下のような文字列が数百件分あります。

これを、エクセルで以下のような状態にする為の方法をお願いします。

○○○○○○

住所 〒123-4567 ○○県○○市○○町12?345 ●●●●●

TEL 03-1234-4567

●●●●●●●●●●●●●●

△△△△△△

住所 〒765-4321 △△県△△市△△町12?345 ●●●●●

TEL 06-1234-4567

●●●●●●●●●●●●●●

・記載のまま実データには、改行が含まれています。
・記載のまま実データには、半角or全角スペースが含まれています。
・記載のまま実データには、●●●という固定の文字列を含みます。
・記載のまま実データには、「住所」「TEL」「〒」という固定の文字列を含みます。

↑これを、以下のように↓
○○○○○○ 123-4567 ○○県○○市○○町12?345 03-1234-4567
△△△△△△ 765-4321 △△県△△市△△町12?345 06-1234-4567

・セル区切りで以下の項目で、一行づつに
・「〒」の文字列は必要ありません。
・「住所」の文字列は必要ありません。
・「TEL」の文字列は必要ありません。
・●●の部分の文字列は不要です。

●質問者: surippa20
●カテゴリ:コンピュータ
○ 状態 :終了
└ 回答数 : 1/1件

▽最新の回答へ

1 ● きゃづみぃ
●500ポイント ベストアンサー

元の文字列が どういう状態かわからないため、二通り 作ってみました。


一つのセルに データが 入っている場合

Sub main()

 元シート = "Sheet1"
 セットシート = "Sheet2"
 
 Worksheets(セットシート).Cells.Delete Shift:=xlUp
 
 Dim a As Long
 Dim b As Long
 
 b = 1
 For a = 1 To Worksheets(元シート).Cells(Rows.Count, "A").End(xlUp).Row
 c2 = Worksheets(元シート).Cells(a, "A")
 
 If Left(c2, 2) = "住所" Then
 Worksheets(セットシート).Cells(b, "A") = c1
 Worksheets(セットシート).Cells(b, "B") = Right(Left(c2, 12), 8)
 c2 = Right(c2, Len(c2) - 13)
 c3 = Left(c2, InStr(c2 & " ", " "))
 c3 = Left(c3, InStr(c3 & " ", " "))
 
 Worksheets(セットシート).Cells(b, "C") = Trim(c3)
 Else
 If Left(c2, 3) = "TEL" Then
 Worksheets(セットシート).Cells(b, "D") = Right(c2, Len(c2) - 4)
 b = b + 1
 
 Else
 If Trim(c2) <> "" Then
 c1 = c2
 End If
 End If
 End If
 Next a
End Sub



それぞれ項目ごと セルが分かれている場合、

Sub main()

 元シート = "Sheet3"
 セットシート = "Sheet4"
 
 Worksheets(セットシート).Cells.Delete Shift:=xlUp
 
 Dim a As Long
 Dim b As Long
 
 b = 1
 For a = 1 To Worksheets(元シート).Cells(Rows.Count, "A").End(xlUp).Row
 c2 = Worksheets(元シート).Cells(a, "A")
 
 If c2 = "住所" Then
 Worksheets(セットシート).Cells(b, "A") = c1
 c4 = Worksheets(元シート).Cells(a, "B")
 Worksheets(セットシート).Cells(b, "B") = Right(c4, 8)
 Worksheets(セットシート).Cells(b, "C") = Worksheets(元シート).Cells(a, "C")
 Else
 If c2 = "TEL" Then
 Worksheets(セットシート).Cells(b, "D") = Worksheets(元シート).Cells(a, "B")
 b = b + 1
 
 Else
 If Trim(c2) <> "" Then
 c1 = c2
 End If
 End If
 End If
 Next a
End Sub



それぞれ
元シート = "Sheet1"
セットシート = "Sheet2"
の箇所を変更して使ってみてください。


surippa20さんのコメント
セルが一つにまとまっていることをお伝えし忘れました。お手数をおかけいたしました。 マクロは正常に動作し、希望通りの住所録になりました。 早々に回答いただき大変助かりました。 ありがとうございました。
関連質問

●質問をもっと探す●



0.人力検索はてなトップ
8.このページを友達に紹介
9.このページの先頭へ
対応機種一覧
お問い合わせ
ヘルプ/お知らせ
ログイン
無料ユーザー登録
はてなトップ