【Excel VBA】携帯番号へ一括でハイフン挿入

質問

ExcelのC列に携帯番号の一覧が400件程度入力されています。
番号が入力されたセルに触れると頭のゼロが取れてしまう為、C列全体の携帯番号を、4桁-3桁-4桁で間にハイフンを一括挿入したいです。

当該ブックのデータは加工して使用します。その加工処理のため、VBAを用いているのでExcel関数ではなくVBA希望です。ただマクロ初心者で上手くコードが書けません。コードを、ご教示頂けますと助かります。

回答No.3

m_and_dmp · ベストアンサー

携帯番号を
標準書式では、
09012345678 と入力すると
9012345678 に変わってしまいます。
セル書式を、00000000000 にすると、09012345678 と表示されます。
セル書式を、000-0000-0000 にすると、090-1234-5678 と表示されます。これで対処したらいかがですか？

VBA ならつぎのようになります。
変換するセル範囲を選択して実行します。
Sub hyphenate()
Dim Target As Range
For Each Target In Selection
NN = Target.Value
Target.Value = "0" & Left(NN, 2) & "-" & Mid(NN, 3, 4) & "-" & Right(NN, 4)
Next Target
End Sub

お礼

言葉不足で失礼しました。
セルの書式設定で変更できる事は、知っています。

書式設定で「-」を入れ000-0000-0000にすると、仰る通り090-1234-5678と表示されます。但し、この場合はそのセルを選択すると頭のゼロが消えるのと、目には090-1234-5678と見えますが、このブックから携帯番号を別のブックへコピーしようとすると、9012345678となります。

桁区切り(3桁、4桁、4桁)は携帯番号と同じですが、本当は携帯番号ではなく3Gや4Gの回線番号です。業務上、別のもの(Excelブックであったり、会社の基幹システム)へコピー＆ペーストをする事があるので、VBAで強制的に「-」を一括挿入してしまいたかったんです。

ご教示頂いたコードを実行すると、「02032448282」が「002-0324-8282」となりましたが、以下の部分を修正したらできました！ありがとうございます。

変更前）Target.Value = "0" & Left(NN, 2) & "-" & Mid(NN, 3, 4) & "-" & Right(NN, 4)

変更後）Target.Value = Left(NN, 3) & "-" & Mid(NN, 3, 4) & "-" & Right(NN, 4)

回答No.2

m5048172715

私は昔社内に対してそんな関数などをよくリリースしていましたが、

1セルの携帯番号を4桁-3桁-4桁で間にハイフンを一括挿入という目的のアルゴリズム

1つ目のセルを文字列Aに読み込む
Aの1～4桁目を、文字列Bに新規追加、ハイフンを追加、
Aの5～7桁目を、文字列Bに追加、ハイフンを追加、
Aの8～11桁目を、文字列Bに追加
Bを1つ目のセルに書き込む

を1セットにして、forループで2行目移行も回せば良いと思う。1個1個のステートメントは簡単である。エラーが出たらそのときまた考える。

文字列の一部を切り出すのは、Mid関数
https://www.sejuku.net/blog/32511
か。忘れていた。調べて思い出した。

お礼

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

回答No.1

kkkkkm

> 番号が入力されたセルに触れると頭のゼロが取れてしまう

これがVBAでやるとどうなるか分からないのでとりあえず0が残ると仮定して以下で試してみてください。
(念のためにD列に書きだします)

> 4桁-3桁-4桁

携帯番号という事なので3桁-4桁-4桁にしてますが
4桁-3桁-4桁でしたら-8を-7に - 7, 4を - 6, 3にしてください。

Sub Test()
Dim i As Long

For i = 1 To Cells(Rows.Count, "C").End(xlUp).Row
Cells(i, "D").Value = Left(Cells(i, "C").Value, Len(Cells(i, "C").Value) - 8) & _
"-" & Mid(Cells(i, "C").Value, Len(Cells(i, "C").Value) - 7, 4) & _
"-" & Right(Cells(i, "C").Value, 4)
Next

End Sub

もし頭の0が外れてしまうのでしたら以下の部分を変更してください。

Cells(i, "D").Value = Left(Cells(i, "C").Value, Len(Cells(i, "C").Value) - 8) & _
を
Cells(i, "D").Value = "0" & Left(Cells(i, "C").Value, Len(Cells(i, "C").Value) - 8) & _

お礼

実行時エラー'5':
プロシージャの呼び出し、または引数が不正です

と表示されてしまい上手くいきませんでした。