エクセルで、文字列から文字を取り出す自動マクロを教えてください。

質問

住所の入った、エクセルのファイルを頂くのですが、Ｃ２せるから、Ｃ５０程度のセルまでに
「〒１２３－４５６７兵庫県○○市○○３－４－５」と
一つのセルに入っています。
これをマクロで、Ｃ列の前に、一列挿入して、自動的に、〒番号の部分を切り取って、貼り付けるという
操作を、マクロでくみたいのです。
データは毎週貰うのですが、件数は５件～５０件程度までと幅はあります。データは２行目から連続して並んでいます。「列を挿入して」「LEFT関数で取り出すという関数をＣ２に入力」「数式をデータが終わるところまでコピー」「元のデータから〒番号を消去」というマクロを組みたいのです。お手数ですが、初心者にでも分かるようにマクロを教えて頂けませんでしょうか？

回答No.7

KenKen_SP · ベストアンサー

#6 です。

あまりスマートな方法ではありませんが。

#6 で補足いただけなかったのですが、住所はC列かD列か、、というのは1シート内
では統一されているものとします。それを Find で探しています。

Option Explicit

Sub Sample()

　　Dim lngROWNUM As Long
　　Dim lngCOLNUM As Long
　　Dim ADDRESS_C As Range
　　Dim i　　　　 As Long
　　Dim strDATA　 As String
　　Dim lngANSWER As Long

　　'住所の列を探します
　　Set ADDRESS_C = Cells.Find( _
　　　　What:="〒???-????*", _
　　　　LookIn:=xlValues, _
　　　　LookAt:=xlWhole, _
　　　　MatchCase:=False, _
　　　　MatchByte:=False)
　　If ADDRESS_C Is Nothing Then
　　　　MsgBox "データがありません", vbCritical
　　　　Exit Sub
　　End If
　　lngCOLNUM = ADDRESS_C.Column
　　Set ADDRESS_C = Nothing

　　'最終行番号取得
　　lngROWNUM = Cells(65536, lngCOLNUM).End(xlUp).Row
　　If lngROWNUM = 1 Then
　　　　MsgBox "データがありません", vbCritical
　　　　Exit Sub
　　End If

　　'画面描写停止
　　Application.ScreenUpdating = False

　　'郵便番号と住所の2列を挿入
　　Columns(lngCOLNUM + 1).Insert
　　Columns(lngCOLNUM + 1).Insert

　　'2行目から最終行までループ処理
　　For i = 2 To lngROWNUM
　　　　strDATA = Cells(i, lngCOLNUM).Text
　　　　If StrConv(strDATA, vbNarrow) Like "〒###-####*" Then
　　　　　　'郵便番号切り出し（〒マークはカット=2文字目から8文字）
　　　　　　Cells(i, lngCOLNUM + 1).Value = _
　　　　　　StrConv(Mid$(strDATA, 2, 8), vbNarrow)
　　　　　　'住所切り出し(10文字目以降）
　　　　　　Cells(i, lngCOLNUM + 2).Value = _
　　　　　　Mid$(strDATA, 10)
　　　　End If
　　Next i

　　'列幅調整・見出し
　　Columns(lngCOLNUM + 1).AutoFit
　　Columns(lngCOLNUM + 2).AutoFit
　　Cells(1, lngCOLNUM + 1).Value = "郵便番号"
　　Cells(1, lngCOLNUM + 2).Value = "住所"

　　'画面描写停止解除
　　Application.ScreenUpdating = True

　　'削除確認
　　Columns(lngCOLNUM).Select
　　lngANSWER = MsgBox( _
　　　　Prompt:="郵便番号と住所を分離しました。" & vbCrLf & vbCrLf & _
　　　　　　　　"分離前データを削除しますか？", _
　　　　Buttons:=vbQuestion Or vbYesNo Or vbDefaultButton2, _
　　　　Title:="削除確認")
　　If lngANSWER = vbYes Then
　　　　'元データの削除
　　　　Selection.Delete
　　End If

End Sub

お礼

ありがとうございました。

私の質問形式がつたない状態で、いろいろとありがとうございました。

想像通りのマクロです。

助かりました。

ほんとに感謝しています。

回答No.6

KenKen_SP

＞ 住所の列がＣ列だったりＤ列だったりしているようです。

ここは処理に際し、重要な点です。もっと具体的に補足して下さ
い。回答者にとって、元データの様子は断片的にしか見えてませ
ん。

1.　ご質問の趣旨ですが、次のどちらですか？（重要）

　　・動作するマクロを希望
　　・マクロの書き方を知りたい--＞多少の不都合は自分で直す

2.　なぜ、C 列 や D 列 になったりするのでしょう？（重要）
　　--＞
　　これにより、住所が C 列にあるのか D 列にあるのかを判定
　　する必要がありそうです。

3.　同一シート内であっても行によって C 列だったり、D 列
　　だったり、バラバラなのですか？（重要）
　　--＞
　　行ごとに住所のあるセルを判定しなければならないかを確認
　　するためです。

4.　切り出した郵便番号で〒マークは不要？
　　--＞仕様が変わってきてますね、、、

補足

いろいろとありがとうございます。

Ｃ列なのかＤ列なのかは、先方のスキルの問題の
用ですが、こちらから、統一してくれとお願いしても
なかなか難しいようです。

ですので、Ｃ列かＤ列かの判定が必要になるとおもいます。同一ブックに同様なシートが複数有り
シートによっても、Ｃ列とＤ列と２種類有ります。
この２列だけのようです。

郵便番号は不要です。

動作するマクロを作って頂きたくお願いしたいと思います。

いろいろとお手数をおかけしますが、よろしくお願いします。

回答No.5

Wendy02

こんばんは。Wendy02です。

＞もう一列挿入して、郵便番号以下のデータを挿入する」
＞「元々のデータの列を削除する」

#1 の補足説明を読んで、#2 の補足説明を読むと、どうすればよいのか見当がつきません。

マクロの内容を指定しないで、どのような結果を望んでいるかを示してほしいです。

マクロの方法自体の段取りを指定するのでしたら、ご自身でコーディングしてください。それを掲示して質問してください。

例:

　　　C列
〒１２３－４５６７兵庫県○○市○○３－４－５
　　　　　↓

　　　C列　　　　　　　　　　　D列
１２３－４５６７　　　兵庫県○○市○○３－４－５

以下は、配列で処理していますから、データに対して、挿入だの削除だのということは二の次になります。

Sub ZipCodePickupR()
　 Dim myArray() As Variant
　 Dim c As Range
　 Const START_ROW = 2 '最初の行
　 With Range("C" & START_ROW, Range("C65536").End(xlUp))
　　　myArray() = .Value
　　　.ClearContents
　　　Application.ScreenUpdating = False
　　　For i = LBound(myArray, 1) To UBound(myArray, 1)
　　　　 If StrConv(myArray(i, 1), vbNarrow) Like "〒###-####*" Then
　　　　　　'C列
　　　　　　.Cells(i, 1).Value = Mid$(myArray(i, 1), 2, 8)
　　　　　　'D列
　　　　　　.Cells(i, 2).Value = Mid$(myArray(i, 1), 10)
　　　　 End If
　　　Next
　　　'C列 セル幅調整
　　　.Columns(1).AutoFit
　　　'D列　セル幅調整
　　　.Columns(2).AutoFit
　 End With
　 Application.ScreenUpdating = True
End Sub

D列をE列にしたかったら、2を3に換えてください。

補足

言葉足らずで、申し訳ないです。
今朝、再度、依頼先に確認しましたところ
住所の入っている列はＣ列かＤ列２種類あるとのことで
Ｄ列に入っている方が多いとのことでした。

Ｄ列に入っているときのデータは

　　Ｄ列　　　　　　　　　　　　　　Ｅ列　　　　Ｆ列～～Ｕ列
１　郵便番号・住所１　　　　　　　　住所２　　　姓　　　質問Ｚ
２　〒１２３－４５５６兵庫県※※※　２－３－４　木村　　　３
３　〒５４３－２１０９大阪府※※※　５－６－７　田中　　　４

となっています。
これを

　 Ｄ列　　　　　　　Ｅ列　　　　　Ｆ列　　　　Ｇ列
1　郵便番号　　　　　住所１　　　　住所２　　　姓
2　１２３－４５５６　兵庫県※※※　２－３－４　木村
3　５４３－２１０９　大阪府※※※　５－６－７　田中

とＤ列の所を２分割する感じです。
お手数ですが、よろしくお願いします。

回答No.4

kamejiro

住所の長さが１００文字以下であれば、

Sub テスト()
　　For i = 2 To 50
　　　　Cells(i, 4) = Mid(Cells(i, 3), 10, 100)
　　Next i
End Sub

とすると、１０文字目（頭の９文字例えは、〒１２３－４５６７を無視して）から有効になります。

有効な行まで、（空白になるまで）の場合、

Sub テスト()
　　i = 2
　　Do Until Cells(i, 3) = ""
　　　　Cells(i, 4) = Mid(Cells(i, 3), 10, 100)
　　　　i = i + 1
　　Loop
End Sub

にすると良いのでしょうか。
また、郵便番号を完全に抹殺してしまうのであれば、

Sub テスト()
　　i = 2
　　Do Until Cells(i, 3) = ""
　　　　Cells(i, 3) = Mid(Cells(i, 3), 10, 100)
　　　　i = i + 1
　　Loop
End Sub

でも良いのでしょうか。
※実行する前に、データは事前に保存しておいて下さいね。

補足

いくつもコーディングありがとうございます。

下の質問の補足にも書いたのですが、
住所の列がＣ列だったりＤ列だったりしているようです。
また、Ｂ列やＥ列にも別のデータが入っています。
住所の列がＤ列の場合、
「Ｄ列の前に一列挿入」→「Ｄ列に〒番号のみ書き込む」→「Ｅ列に〒番号以下のみを書き込む」→「列の幅を自動調整」
という流れのコーディングをお願いできますでしょうか？お手数ですが、よろしくお願いします。
〒番号は「〒※※※－※※※※」は全部全角です。

回答No.3

KenKen_SP

こんにちは。KenKen_SP です。

＞元のデータから〒番号を消去...

と考えるとちょっと難しくなるので、

「元データの先頭から9文字、およびそれ以降を別々の場所に書き出して、
最後に元データを削除する」

とした方が処理としては楽だと思います。

また、郵便番号部が半角とか全角で統一されているなら、マクロを使わず
とも [データ]-[区切り位置]-[固定長...] で分解することもできますね。

Sub Sample()

　　Dim lngROWNUM As Long
　　Dim i　　　　 As Long
　　Dim Sh　　　　As Worksheet
　　Dim lngANSWER As Long

　　'対象シート定義 ※要書き換え
　　Set Sh = ThisWorkbook.Sheets("Sheet1")

　　With Sh
　　　　'最終行番号取得
　　　　lngROWNUM = .Cells(2, "C").End(xlDown).Row
　　　　'画面描写の停止
　　　　'Application.ScreenUpdating = False
　　　　'確認のため２列を元データの後ろへ挿入
　　　　.Columns("D:E").Insert
　　End With

　　'最終行までループ
　　For i = 2 To lngROWNUM
　　　　With Sh.Cells(i, "C")
　　　　　　'先頭に〒番号があるか？
　　　　　　If StrConv(.Value, vbNarrow) Like "〒###-####*" Then
　　　　　　　　'C列の1つ横D列に9文字抜き出したものを記入
　　　　　　　　.Offset(0, 1).Value = Left$(.Value, 9)
　　　　　　　　'C列の2つ横E列に残りを記入
　　　　　　　　.Offset(0, 2).Value = Mid$(.Value, 10)
　　　　　　End If
　　　　End With
　　Next i

　　'D:E列の列幅調整
　　Sh.Columns("D:E").AutoFit

　　'画面描写の停止解除
　　Application.ScreenUpdating = True
　　'削除確認
　　lngANSWER = MsgBox( _
　　　　Prompt:="郵便番号と住所を分離しました。" & vbCrLf & vbCrLf & _
　　　　　　　　"C列の分離前データを削除しますか？", _
　　　　Buttons:=vbQuestion Or vbYesNo Or vbDefaultButton2, _
　　　　Title:="削除確認")
　　If lngANSWER = vbYes Then
　　　　'元データのC列削除
　　　　ActiveSheet.Columns("C").Delete
　　End If

　　Set Sh = Nothing

End Sub

補足

>'対象シート定義 ※要書き換え
>　　Set Sh = ThisWorkbook.Sheets("Sheet1")
ここはどのように書き換えたらよろしいでしょうか？
一つのブックに「20051127」「20051102」などの
名前のシートが並んでいます。

>　　'最終行までループ
>　　For i = 2 To lngROWNUM
>　　　　With Sh.Cells(i, "C")
>　　　　　　'先頭に〒番号があるか？
>　　　　　　If StrConv(.Value, vbNarrow) Like "〒###-####*" Then
ここの「〒###-###*」の箇所ですが
〒番号は全角で入っています。

また住所の入っている列はＣ列だったりＤ列だったり
しているようです。
対象となる列のＣ２セルなりＤ２セルなりにカーソルが
有る状態にしてからのマクロの実行という操作に変更できますでしょうか？

お手数ですが、よろしくお願いします。

回答No.2

Wendy02

こんばんは。

＞Ｃ列の前に、一列挿入して、
としたら、データ列は、D列になりますが、それでよいのでしょうか？

Sub ZipCodePickup()
Dim c As Range
Columns(3).Insert
For Each c In Range("D2", Range("D2").End(xlDown))
　If StrConv(c.Value, vbNarrow) Like "〒###-####*" Then
　　c.Offset(, -1).Value = Mid$(c.Value, 2, 8)
　End If
Next c
Columns(3).AutoFit
End Sub

補足

早速ありがとうございました。
したの質問への回答にも書いたのですが、元々の
Ｃ列のデータから抜き出した、郵便番号を
消すと言う操作もマクロに入れたいのですが
どうすればいいでしょうか？
「教えていただいたマクロを実行する」
「もう一列挿入して、郵便番号以下のデータを挿入する」
「元々のデータの列を削除する」
といった、感じの操作マクロが出来ますか？

回答No.1

kamejiro

Sub test()
　　For i = 2 To 50
　　　　Cells(i, 4) = Mid(Cells(i, 3), 1, 8)
　　Next i
End Sub

Ｃ２セルからＣ５０セルまでを
Ｄ２セルからＤ５０セルに、頭８文字入れるモノです。

お確かめ下さい。

補足

早速ありがとうございます。
このマクロで、Ｄ列ではなくて、Ｅ列とかに
するなら、３行目の最初を
Cells(i,5)
に変更すれば、いいのですね。

よくわかりました。

元々のＣ列のデータから郵便番号の部分だけを消去することは出来ませんでしょうか？