エクセルデータにて、列順変更のマクロを作成中です。

質問

エクセルデータにて、列順変更のマクロを作成中です。
項目名を検索しならびを変えていますが、項目名が突然「郵便番号」⇒「〒」、「〒番号」など
に変更されてしまいます。その場合に、MsgBoxをInputBoxにし今回は「郵便番号」がないので
代わりに「〒」を代入する方法をとりたいのですが、どのようにマクロを書いたらよいですか。
よろしくお願いいたします。

【処理内容】
A列、B列、C列、D列
電話番号、名前、住所、郵便番号
　　　↓へ列のならびを変更
A列、B列、C列、D列
名前、郵便番号、住所、電話番号

【マクロ】
Sub 列順変更()

Dim fld As Variant
Dim rng As Range
Dim c As Integer

Sheets("Sheet2").Cells.Clear
c = 1

For Each fld In Array("名前", "郵便番号", "住所", "電話番号")
Set rng = Rows(1).Find(fld, LookAt:=xlWhole)
If rng Is Nothing Then
MsgBox fld & " がありません"
Exit Sub
Else
rng.EntireColumn.Cut Sheets("Sheet2").Cells(1, c)
c = c + 1
End If
Next

MsgBox "処理が完了しました。" & vbCrLf & "Sheet1に残ったデータを再確認してください。"

End Sub

回答No.3

watabe007 · ベストアンサー

For Each fld In Array("名前", "郵便番号", "住所", "電話番号")
　　fld2 = fld
　　Do
　　　　Set rng = Rows(1).Find(fld2, LookAt:=xlWhole)
　　　　If Not rng Is Nothing Then Exit Do
　　　　fld2 = InputBox(fld2 & "がありません、代わりの項目名を入力して下さい。")
　　Loop
　　rng.EntireColumn.Cut Sheets("Sheet2").Cells(1, c)
　　c = c + 1
Next

回答No.2

watabe007

>MsgBoxをInputBoxにし今回は「郵便番号」がないので
こんな事、かな
For Each fld In Array("名前", "郵便番号", "住所", "電話番号")
　　Set rng = Rows(1).Find(fld, LookAt:=xlWhole)
　　fld2 = fld
　　Do While rng Is Nothing
　　　　fld2 = InputBox(fld2 & "がありません、代わりの項目名を入力して下さい。")
　　　　Set rng = Rows(1).Find(fld2, LookAt:=xlWhole)
　　Loop
　　rng.EntireColumn.Cut Sheets("Sheet2").Cells(1, c)
　　c = c + 1
Next

お礼

watabe2007さん。ありがとうございました。
思っていたとおりの動きになりました。

回答No.1

watabe007

>項目名が突然「郵便番号」⇒「〒」、「〒番号」などに変更されてしまいます。
全て検索をかければ
For Each fld In Array("名前", "郵便番号", "〒", "〒番号", "住所", "電話番号")　　
　　Set rng = Rows(1).Find(fld, LookAt:=xlWhole)
　　If Not rng Is Nothing Then
　　　　rng.EntireColumn.Cut Sheets("Sheet2").Cells(1, c)
　　　　c = c + 1
　　End If
Next

補足

ご回答ありがとうございました。
データは例で挙げたもののみではなく、20列程あり項目名が毎回異なるものが入ってくる為、
困っております。「郵便番号」⇒「〒」「〒番号」「ゆうびん」「A」「番号」に変わっていたり
します。できれば毎回マクロの中身を修正ではなく、InputBoxを使用し、回避したいと考えております。
よろしくお願いいたします。