【VBA】電話番号の頭に0をつけたり、ハイフンを挟むマクロ

タイトル通り、電話番号の頭に0をつけたり、ハイフンを挟むマクロを作りました。

データを落としてExcelで取り込んだときに、0が抜けて81がついていたときとかに使えます。
超ニッチですが思います笑

目次

実際のコード

Option Explicit

Sub 電話番号修正()

Dim i As Long, n As Long, m As Long, o As Long
Dim a, b(), d, key
Dim aa
Dim rag As Range

Set rag = セル位置

If rag Is Nothing Then Exit Sub

a = rag

ReDim Preserve b(1 To UBound(a) + 1, 1 To 1)


For n = 1 To UBound(a)

'番号を変数にいれ、selctcaseで分岐させる

aa = a(n, 1)

    Select Case Left(aa, 3)
   
    '050の場合
        Case "815"
       
    key = "0" & Mid(aa, 3, 2) & "-" & Mid(aa, 5, 4) & "-" & Right(aa, 4)
   
    '0120の場合
        Case "811"
    key = "0" & Mid(aa, 3, 3) & "-" & Mid(aa, 6, 3) & "-" & Right(aa, 3)
   
    '0800の場合
        Case "818"
    key = "0" & Mid(aa, 3, 3) & "-" & Mid(aa, 6, 3) & "-" & Right(aa, 4)
   
    'その他の場合
        Case Else
   key = aa

End Select

b(n, 1) = key

Next n

rag = b

End Sub


Function セル位置() As Range


'エラー回避
On Error Resume Next

'タイプ8がレンジオブジェクト
Set セル位置 = Application.InputBox(Prompt:="セルを選択してください。", Type:=8)

On Error GoTo 0
   
If セル位置 Is Nothing Then Exit Function


End Function

このまま張り付けて試してみて下さい。

自分で選んだ範囲が修正される

今回は特に範囲の指定はしていません。

なので、そのままShift+Ctrlとかで選んでエンターでOKです。

解説

メインはSelect Caseです。

これで分岐させています。

Select Case 比較値

Case 条件1

条件1を満たしたときどうする?

Case 条件2

条件2を満たしたときどうする?

Case Else

条件を満たさない場合

End Select

こんな風に書きます。

おわり

複雑なマクロより、こういうシンプルでスパッと決まるやつのほうがやりがいがありますよね。

周りの反応もいいです。(使う機会はほぼ0だけどw)

[temp id=2]

コメント

コメントする

目次