「-」を入れるExcelマクロ

質問

Excelで電話番号の表があります。テキストで、電話番号が入力されています。
「xxx-xxxx-xxxx」と「xxxxxxxxxxx」が混在しているので、「xxx-xxxx-xxxx」に揃えたい。
さて、どのようにすればよいでしょうか？

私の、そのリストは、「xxx-xxxx-xxxx」は、全て正しい位置に、「-」が入っているので、修正する必要はありません。
「xxxxxxxxxxx」は、普通の電話の10ケタと、携帯の11ケタが混在しています。
052であれば、052-xxx-xxxx
0561であれば、0561-xx-xxxx
に修正したい。しかし、私の、修正したいと思っているリストは、市外局番は、数個です。なので、
052の場合、0561の場合と言ったように、数個分の分岐を作ればよいかなと思っていますが、その方法が判らないので、教えていただけないでしょうか？

関数で作りだしたのですが、なにかとても、複雑な関数になってしまい、訳が分からなくなってしまい、困っています。
私は、マクロの知識が無いのですが、マクロであれば、スマートにできるのは無いかとも思っています。

以上、よろしくお願いします。

回答No.9

kkkkkm · ベストアンサー

> .Offset(0, 1).Value = Left(c.Value, 3) & "-" & Mid(c.Value, 4, 3) & "-" & Right(c.Value, 4)
> の記述がスキップされて処理されてしまっているように、自分には思えます。

まったくその通りでした。先のものを急いで修正して前のテストデータを消さず実行したために052yyyxxxxの部分だけ前のものが残ったままで書き込みされていないのに気が付きませんでした。以下のように修正してください。もともとですが、052以外でも4桁以外の市外局番であれば3桁として「-」が入ります。

Sub Test()
Dim c As Range
Dim k As Variant, i As Long
Dim mFlg As Boolean

k = Array("0561", "0562", "0563")

For Each c In Range("A1:A10")
If InStr(c.Value, "-") = 0 Then
If Len(c.Value) = 11 Then
c.Offset(0, 1).Value = Left(c.Value, 3) & "-" & Mid(c.Value, 4, 4) & "-" & Right(c.Value, 4)
ElseIf Len(c.Value) = 10 Then
mFlg = False
For i = LBound(k) To UBound(k)
If Left(c.Value, 4) = k(i) Then
c.Offset(0, 1).Value = Left(c.Value, 4) & "-" & Mid(c.Value, 5, 2) & "-" & Right(c.Value, 4)
mFlg = True
End If
Next
If mFlg = False Then
c.Offset(0, 1).Value = Left(c.Value, 3) & "-" & Mid(c.Value, 4, 3) & "-" & Right(c.Value, 4)
End If
End If
Else
c.Offset(0, 1).Value = c.Value
End If
Next
End Sub

お礼

本当にありがとうございます。
No8様からご指摘いただいているような、055と0553のような問題は、私はなく、
0561や、ほか数個の市外局番だけの良いため、
kkkkkm様のマクロは、私のニーズを、完全に満たします。
これで、今まで、時間を掛けて手修正していたタスクが一瞬で終了するようになりました。

回答No.14

bunjii

>私は、マクロの知識が無いのですが、マクロであれば、スマートにできるのは無いかとも思っています。
それは誤りをです。
あなたが言う「マクロ」とは「VBAでプログラムを書く」ことと思います。
Excelに標準で組み込まれた関数を組み合わせて数式を書いた方が分かり易いはずです。
因みに、固定電話の10桁の数字は右側4桁がユーザー番号で左側6桁が市外局番+市内局番であることをご存知ですよね？
市外局番と市内局番の境い目を判別するには市外局番の一覧表が必要であることを認識してください。
例えば、名古屋の市外局番が"052"であれば市内局番は必ず3桁になります。
瀬戸の市外局番が"0561"であれば市内局番は2桁しかありません。
回答No.8で提起されている"0552222222"と"0553333333"から市外局番を切り出すために"055"（沼津、甲府）と"0553"（山梨）が収録されたデータベースが必要になります。（"0552"や"05522"という市外局番は無いようです）
市外局番一覧表は https://www.telnavi.jp/landline/ から入手できます。
A列に修正対象のデータが有り、B列に市外局番一覧があるとき次の数式で市外局番の桁数をチェックできます。
=IF(AND(LEN(A1)=10,FIND("-",A1&"-")>LEN(A1)),LEN(INDEX(B$1:B$388,MAX(INDEX((FIND(B$1:B$388,A1&B$1:B$388)=1)*ROW(B$1:B$388),0)))),"")

尚、市外局番を抜き出すには次の数式で良いでしょう。
=IF(AND(LEN(A1)=10,FIND("-",A1&"-")>LEN(A1)),INDEX(B$1:B$388,MAX(INDEX((FIND(B$1:B$388,A1&B$1:B$388)=1)*ROW(B$1:B$388),0))),"")

回答No.13

kon555

>>0561yyxxxxが、0561-yy-xxxxとなるように期待されるのですが、0561yy-xxxxになってしまいます
こちらで組んだ状態のマクロは、問題なく0561も認識しました。
また0561yyxxxxがそのままになる場合はともかく、0561yy-xxxxとなるケースだと原因はかなり絞り込まれます。

1.市外局番のリストに「0561yy」という市外局番が存在し、かつリストの上位にある場合(ないと思うんですけどね)。
2.市外局番のリストの「0561」が、スペースその他によって「0561・・」のような6文字と認識されている場合

おそらくこの2つのどちらかではないかと思います。もしよければ確認してみてください。
まあNo.5様のマクロの方が本筋のようですし、不要となればそれまでですが。

なお個人的経験からは、データ整形系のマクロはイレギュラーなデータ時には停止するなりセル色を変えるなり、作業者が異常データだと認識できるようにしておいた方が作業性が上がります。
実際の作業に使用される場合は、その辺りも織り込んむと快適なツールに仕上がると思います。

がんばって下さい。

回答No.12

bunjii

回答No.11のフローチャートに誤りがありました。
2番目の条件分岐は電話番号の桁数チェックで8桁は誤りで10桁に訂正してください。
尚、携帯電話の番号は先頭から3桁目が"0"であることも判断要素になります。
携帯電話の表記は"090-yyyy-xxxx"のようにするのでしょうか？
また、"050"から始まるIP電話の表記はどうしますか？

お礼

本件、kkkkkm様からいただいた回答で、私の問題は解決しました。

＞　"050"から始まるIP電話の表記はどうしますか？
kkkkkm様のフローで、私のニーズを満足しました。
050や、090を、どうするのかと言うと、kkkkkm様の書いていただいたコードのような対応をやりたいと思ってました。

ただし、きっと世の中には、No8様の対応が必要な方も
いらっしゃるだろうと思いました。

回答No.11

bunjii

>If関数も、数個あると面倒になってくるし、名古屋と瀬戸だけじゃないと書いた通りです。
市外局番が数種類であっても照合の論理は先頭から市外局番を順次照合しないと市外局番と市内局番の区切り位置が分かりませんので多重でif関数を使わなければならないでしょう。
条件分岐のフローチャートを作成してExcel関数を使うかVBA関数で処理するかを選択してください。
全国の市外局番を全て照合対象にするときはVBAでプログラムを組まないと無理でしょう。

>毎月、修正する必要があるようなタスクです。
元データが入力者の気儘で不統一なフォーマットになっているのであれば入力フォーマットを守るように指導するべきではないでしょうか？
専門のプログラマーに有償で依頼すべき内容のようです。
考え方としてはフローチャートのサンプルを提示しますので参考にしてください。

お礼

フローチャートありがとうございました。

> 元データが入力者の気儘で不統一なフォーマットになっているのであれば入力フォーマットを守るように指導するべきではないでしょうか？
私の処理したいデータの出所が、2か所あって、その情報を、私がマージしているために、発生しています。つまり、1か所は、「-」を入れていないフォーマット、もう一つは、「-」を入れているフォーマットを採用しているのです。

回答No.10

kkkkkm

誤解はしないと思いますが、以下に訂正です。

052以外でも4桁以外の市外局番
↓
10桁で052以外でも指定した4桁以外の市外局番

あと追加しようとしてたのに忘れてました。
以下の部分で
If Left(c.Value, 4) = k(i) Then
c.Offset(0, 1).Value = Left(c.Value, 4) & "-" & Mid(c.Value, 5, 2) & "-" & Right(c.Value, 4)
mFlg = True
Exit For '←これを追加したほうがいいと思います。
End If

あと、No7のbunjii さんのお礼に記載されていたデータでテストしましたが
090989yyxxxx
これは12桁なので対応していません。

お礼

＞10桁で052以外でも指定した4桁以外の市外局番
はい、承知しております。
マクロは、ほとんど、素人ですが、今日半日で、かなり勉強しました。
本当にありがとうございました。
12ケタの電話番号はあり得ませんね、すみません、yyとxxxxの変更をするときに間違えました。

回答No.8

HohoPapa

周知のとおり、
市外局番は、2,3,4,5桁のものがあります。

厄介なのは、例えば、
0552222222
0553333333
この２つの電話番号の場合
市外局番が前者は055、後者は0553になることです。
そのため、
出来合いの関数でやることも可能ですが
相当な作業列や関数を組み合わせる必要があり、
現実的ではないと思います。

VBAでの解決を目指しているようですので
VBAでオリジナルな関数を作成して対応する例を紹介します。
よかったら挑戦してみてください。

作業１
添付画像のように、シート名"ListTelNum"のシートを用意し
市外局番の一覧を用意してください。

作業２
標準モジュールに下記のコードを貼り付けてください。

作業３
電話番号を変換したいセルに、
添付画像を参考に、
=GetTelNum(B2)　といった関数を埋めてください。

以下、コードです。

Option Explicit

Function GetTelNum(TelNum As String) As String

　Dim wkLen As Long

　wkLen = GetTelLen(TelNum)
　GetTelNum = TelNum

　If IsNumeric(TelNum) = False Then Exit Function
　If Len(TelNum) = 11 Then
　　GetTelNum = _
　　　Left(TelNum, 3) & "-" & _
　　　Mid(TelNum, 4, 4) & "-" & _
　　　Right(TelNum, 4)
　End If

　If Len(TelNum) <> 10 Then Exit Function
　If ((wkLen < 2) Or (wkLen > 5)) Then Exit Function

　GetTelNum = _
　　Left(TelNum, wkLen) & "-" & _
　　Mid(TelNum, wkLen + 1, 10 - wkLen - 4) & "-" & _
　　Right(TelNum, 4)

End Function

Function GetTelLen(TelNum As String) As Long

　Dim cn As Object
　Dim rs As Object
　Dim SQL1 As String
　Dim SQL2 As String

　Set cn = CreateObject("ADODB.Connection")
　Set rs = CreateObject("ADODB.Recordset")

　cn.Provider = "Microsoft.ACE.OLEDB.12.0"
　cn.Properties("Extended Properties") = "Excel 12.0;HDR=NO;IMEX=1"
　cn.Open ThisWorkbook.FullName

　GetTelLen = 0

　SQL1 = "SELECT [F1] as SGNum" & vbCrLf
　SQL1 = SQL1 & "FROM [ListTelNum$A1:A1000]" & vbCrLf
　SQL2 = "Where [F1] = '" & Left(TelNum, 5) & "'" & vbCrLf
　rs.Open SQL1 & SQL2, cn
　If rs.EOF = False Then
　　GetTelLen = 5
　Else
　　SQL2 = "Where [F1] = '" & Left(TelNum, 4) & "'" & vbCrLf
　　rs.Close
　　rs.Open SQL1 & SQL2, cn
　　If rs.EOF = False Then
　　　GetTelLen = 4
　　Else
　　　SQL2 = "Where [F1] = '" & Left(TelNum, 3) & "'" & vbCrLf
　　　rs.Close
　　　rs.Open SQL1 & SQL2, cn
　　　If rs.EOF = False Then
　　　　GetTelLen = 3
　　　Else
　　　　SQL2 = "Where [F1] = '" & Left(TelNum, 2) & "'" & vbCrLf
　　　　rs.Close
　　　　rs.Open SQL1 & SQL2, cn
　　　　If rs.EOF = False Then
　　　　　GetTelLen = 2
　　　　End If
　　　End If
　　End If
　End If

　rs.Close
　Set rs = Nothing
　cn.Close
　Set cn = Nothing

End Function

お礼

大変完成度のVBAをありがとうございます。
今回、私は、市外局番は、せいぜい数個で、かつ055と0553のような問題を抱えていないため、kkkkkm様のマクロを使っていこうと思っています。
No8様のVBAは、きっと、私以外で、同様な課題を抱えている方の参考になるのではないかと思います。私も、現時点では、kkkkkm様のマクロで充分なのですが、将来、055と0553のような課題を掛かるようなことがありましたら、この方法に挑戦しようと思います。
私にとっては、ご提示いただいたコードを眺めるだけでも、大変勉強になります。

回答No.7

bunjii

>私の、修正したいと思っているリストは、市外局番は、数個です。
数個のデータ（電話番号）を修正するのに関数やマクロ（VBA等）で自動修正するのは非効率的です。
修正したい範囲に条件付き書式で塗りつぶしすれば修正が必要なデータを簡単に見つけられますので手作業の修正が効率的と思います。

>052の場合、0561の場合と言ったように
固定電話の市外局番は2桁～5桁までありなすので区切り位置を何処にするかを判断するためのデータベースが必要になり提示の052（名古屋）、0561（瀬戸）のみであれば難しくありません。（if関数の条件分岐で可能）

>関数で作りだしたのですが、なにかとても、複雑な関数になってしまい、訳が分からなくなってしまい、困っています。
サンプルデータを20個ほど提示して頂けますか？（右側の4桁は****で良い）

お礼

(1)
市外局番は数個ですが、修正しなければならない電話番号は、数百あり、毎月、修正する必要があるようなタスクです。
(2)
If関数も、数個あると面倒になってくるし、名古屋と瀬戸だけじゃないと書いた通りです。
(3)
090-33yy-xxxx
080-69yy-xxxx
080-69yy-xxxx
090989yyxxxx
0561-yy-xxxx
090-85yy-xxxx
090-17yy-xxxx
090-33yy-xxxx
0525yyxxxx
09017yyxxxx
052-3yy-xxxx
0561yyxxxx
0562yyxxxx
09033yyxxxx
050-31yy-xxxx
090-33yy-xxxx
0561yyxxxx

回答No.6

kkkkkm

No5の一部訂正です

0561だけではなく頭が4桁が何種類かあるんですね、見落としてました。
以下に変更して

k = Array("0561", "0562", "0563")
の0561や0562,0563を適宜変更し追加がある場合は
コンマで区切ってダブルクォーテーションで囲ってください。

Sub Test()
Dim c As Range
Dim k As Variant, i As Long

k = Array("0561", "0562", "0563")

For Each c In Range("A1:A10")
If InStr(c.Value, "-") = 0 Then
If Len(c.Value) = 11 Then
c.Offset(0, 1).Value = Left(c.Value, 3) & "-" & Mid(c.Value, 4, 4) & "-" & Right(c.Value, 4)
ElseIf Len(c.Value) = 10 Then
For i = LBound(k) To UBound(k)
If Left(c.Value, 4) = k(i) Then
c.Offset(0, 1).Value = Left(c.Value, 4) & "-" & Mid(c.Value, 5, 2) & "-" & Right(c.Value, 4)
End If
Next
Else
c.Offset(0, 1).Value = Left(c.Value, 3) & "-" & Mid(c.Value, 4, 3) & "-" & Right(c.Value, 4)
End If
Else
c.Offset(0, 1).Value = c.Value
End If
Next
End Sub

お礼

ありがとうございました。
大変参考になりました。この通りのマクロを実行してみたのですが、
052yyyxxxxが052-yyyy-xxxxになりません。

c.Offset(0, 1).Value = Left(c.Value, 3) & "-" & Mid(c.Value, 4, 3) & "-" & Right(c.Value, 4)
の記述がスキップされて処理されてしまっているように、自分には思えます。
できる事でしたら、もうちょっとお付き合いいただければ幸いです。
よろしくお願いします。
以下のマクロを実行しました。

Sub Macro2()
'
Dim c As Range
Dim k As Variant, i As Long
'
k = Array("0561", "0562", "0563")
'
For Each c In Range("C2:C1000")
If InStr(c.Value, "-") = 0 Then
If Len(c.Value) = 11 Then
c.Offset(0, 1).Value = Left(c.Value, 3) & "-" & Mid(c.Value, 4, 4) & "-" & Right(c.Value, 4)
ElseIf Len(c.Value) = 10 Then
For i = LBound(k) To UBound(k)
If Left(c.Value, 4) = k(i) Then
c.Offset(0, 1).Value = Left(c.Value, 4) & "-" & Mid(c.Value, 5, 2) & "-" & Right(c.Value, 4)
End If
Next
Else
c.Offset(0, 1).Value = Left(c.Value, 3) & "-" & Mid(c.Value, 4, 3) & "-" & Right(c.Value, 4)
End If
Else
c.Offset(0, 1).Value = c.Value
End If
Next

End Sub

回答No.5

kkkkkm

ハイフンがなく0561の場合と携帯(11桁の時)を除いては
xxx-xxx-xxxx
にして
0561の場合は
0561-xx-xxxx
に
携帯は
xxx-xxxx-xxxx
にし
ハイフンのあるものはそのままで
元のデータの右列に記載します。

A1からA10までにしていますので適宜変更してください。
Sub Test()
Dim c As Range

For Each c In Range("A1:A10")
If InStr(c.Value, "-") = 0 Then
If Len(c.Value) = 11 Then
c.Offset(0, 1).Value = Left(c.Value, 3) & "-" & Mid(c.Value, 4, 4) & "-" & Right(c.Value, 4)
ElseIf Left(c.Value, 4) = "0561" Then
c.Offset(0, 1).Value = Left(c.Value, 4) & "-" & Mid(c.Value, 5, 2) & "-" & Right(c.Value, 4)
Else
c.Offset(0, 1).Value = Left(c.Value, 3) & "-" & Mid(c.Value, 4, 3) & "-" & Right(c.Value, 4)
End If
Else
c.Offset(0, 1).Value = c.Value
End If
Next
End Sub

お礼

4桁の市外局番が、一つしかない場合には、これで完璧です。
修正しなくてはならない電話番号は、数百あり、今後も定常的に修正が必要になる状態だったので、
市外局番一つの仕様でも、大変ありがたいです。
No6の方に書きましたように、市外局番が複数になった場合には、私の環境では、上手くいかないので、いろいろマクロをいじっているので、満足できるマクロになるように、いろいろ勉強しながら試していきたいです。
ありがとうございます。

回答No.4

kon555

おっしゃる通り、マクロで対応するのがいいと思います。
ちょっと面白そうなので組んで見ました。
Sub　番号ハイフン()
　　　　Dim　セル　As　Range
　　　　Dim　元番号,　改番号,　局番
　　　　Dim　i　As　Long,　s　As　Long
　　　　For　Each　セル　In　Selection　'選択したセルの範囲に対して実行
　　　　　　　　元番号　=　セル.Value
　　　　　　　　改番号　=　""
　　　　　　　　局番　=　""
　　　　　　　　If　IsNumeric(元番号)　=　True　Then　'数値以外が含まれる場合は何もしない
　　　　　　　　　　　　Select　Case　Len(セル.Value)　'文字数で分岐
　　　　　　　　　　　　Case　11　'11文字なら携帯
　　　　　　　　　　　　　　　　For　i　=　1　To　11
　　　　　　　　　　　　　　　　　　　　改番号　=　改番号　&　Mid(元番号,　i,　1)
　　　　　　　　　　　　　　　　　　　　If　i　=　3　Or　i　=　7　Then　改番号　=　改番号　&　"‐"　'市外局番関係なく、機械的にハイフン入れる
　　　　　　　　　　　　　　　　Next　i
　　　　　　　　　　　　　　　　セル.Value　=　改番号
　　　　　　　　　　　　Case　10　'11文字なら一般回線
　　　　　　　　　　　　　　　　For　s　=　1　To　100000　'市外局番リストを頭から見ていく
　　　　　　　　　　　　　　　　　　　　If　Cells(s,　1).Value　=　""　Then　'リストの最後まで行っても一致しなかったら、変なデータが入力されていると判断
　　　　　　　　　　　　　　　　　　　　　　　　MsgBox　"市外局番リストと一致しない10桁の番号が存在します。確認して下さい。"
　　　　　　　　　　　　　　　　　　　　　　　　セル.Select
　　　　　　　　　　　　　　　　　　　　　　　　End
　　　　　　　　　　　　　　　　　　　　End　If
　　　　　　　　　　　　　　　　　　　　局番　=　Cells(s,　1).Value
　　　　　　　　　　　　　　　　　　　　If　Mid(元番号,　1,　Len(局番))　=　局番　Then　Exit　For　'リストのどこかで一致したら検索終わり
　　　　　　　　　　　　　　　　Next
　　　　　　　　　　　　　　　　For　i　=　1　To　10
　　　　　　　　　　　　　　　　　　　　改番号　=　改番号　&　Mid(元番号,　i,　1)
　　　　　　　　　　　　　　　　　　　　If　i　=　Len(局番)　Or　i　=　6　Then　改番号　=　改番号　&　"‐"　'市外局番の後ろと、6文字目の後ろにハイフン入れる
　　　　　　　　　　　　　　　　Next
　　　　　　　　　　　　　　　　セル.Value　=　改番号
　　　　　　　　　　　　Case　Else
　　　　　　　　　　　　　　　　MsgBox　"文字数が10・11以外のデータが存在します。確認して下さい。"　&　vbCrLf　&　Len(セル.Value)
　　　　　　　　　　　　　　　　セル.Select
　　　　　　　　　　　　　　　　End
　　　　　　　　　　　　End　Select
　　　　　　　　End　If
　　　　Next　セル
　　　　MsgBox　"処理が全件完了しました。"
End　Sub
使い方は、A列に頭から市外局番のリストを入力して下さい。
その後変換したいリストの範囲を選択し実行すると、ハイフンが入った形で変換されます。
11文字なら携帯と判断し3文字目と7文字目の後ろにハイフンを入れます。
10文字なら一般回線と判断し、リストにある市外局番の後ろと6文字目の後ろにハイフンを入れます。
リストにない市外局番の場合、警告メッセージが出て止まります。
10,11以外の桁数の場合も警告メッセージが出て止まります。
ただし数字以外が入力されている場合は、既にハイフン入力済みのケースを想定して何もしません。

市外局番という関係上、単純なリストとの一致しか見ていませんが、これで大丈夫なはず・・・あまり自信はないですけど。

ちなみにVBAマクロの使い方はご存知ですか？知らなければ下記のサイトなど、入門向けページを参考にして下さい。
https://tonari-it.com/vba-start-10minutes/

お礼

No5様のマクロとともに、
このマクロも試してました。
0561yyxxxxが、0561-yy-xxxxとなるように期待されるのですが、0561yy-xxxxになってしまいます。
申し訳ありませんが、私の知識では、なぜこうなってしまうのか、
全くお手上げなので、出来れば、ご教示いただけると嬉しいです。
(とは言っても、No5様のマクロを主体に、自分はいま取り組んでいるので、もし正解をいただいても、No5様のマクロを使うかもしれないのですが。。。)

Sub Macro4()
Dim c As Range
Dim Moto, Kai, kyoku
Dim i As Long, s As Long
For Each c In Selection
Moto = c.Value
Kai = ""
kyoku = ""
If IsNumeric(Moto) = True Then
Select Case Len(c.Value)
Case 11
For i = 1 To 11
Kai = Kai & Mid(Moto, i, 1)
If i = 3 Or i = 7 Then Kai = Kai & "-"
Next i
c.Value = Kai
Case 10
For s = 1 To 100000
If Cells(s, 1).Value = "0565" Then MsgBox " 文字数が10・11以外のデータが存在します。"
c.Select
End
End If
kyoku = Cells(s, 1).Value
If Mid(Moto, 1, Len(kyoku)) = kyoku Then Exit For Next
For i = 1 To 10
Kai = Kai & Mid(Moto, i, 1)
If i = Len(kyoku) Or i = 6 Then Kai = Kai & " ]"
Next
c.Value = Kai
Case Else
c.Select
End
End Select
End If
Next c
End Sub