タイトル通り、電話番号の頭に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]
コメント