数字を漢数字に ハイフンを長音記号に アルファベットを全角に変換するマクロ
経緯
\コンニチワ/
例えばイラレの変数でcsvファイルの住所流し込みをするとします。
それが縦書きだった場合、番地は漢数字にしたくなりませんか?
ハイフンは長音記号に(今回「ー」ではないです)したくないですか?
英語は「縦書き中の欧文回転」でという声も聞こえてきそうですが、このマクロではなんとなく半角英語も全角に変換です。
そんなニッチなマクロです。
ちなみに当方は素人なのでツッコミどころ満載かもしれないわけで、一応「使用は自己責任で」ということにさせてください。
そんなマクロだよ
Sub SuujiWoKansuujiHaihunWoTateni
Dim oSheet As Object
Dim oCell As Object
Dim oRange As Object
Dim i As Integer
Dim j As Integer
Dim sText As String
Dim result As String
' 漢数字変換用の配列
Dim kansuji(9) As String
kansuji(0) = "〇"
kansuji(1) = "一"
kansuji(2) = "二"
kansuji(3) = "三"
kansuji(4) = "四"
kansuji(5) = "五"
kansuji(6) = "六"
kansuji(7) = "七"
kansuji(8) = "八"
kansuji(9) = "九"
' 全角アルファベット変換用の配列
Dim zenkakuAlpha(51) As String
zenkakuAlpha(0) = "A"
zenkakuAlpha(1) = "B"
zenkakuAlpha(2) = "C"
zenkakuAlpha(3) = "D"
zenkakuAlpha(4) = "E"
zenkakuAlpha(5) = "F"
zenkakuAlpha(6) = "G"
zenkakuAlpha(7) = "H"
zenkakuAlpha(8) = "I"
zenkakuAlpha(9) = "J"
zenkakuAlpha(10) = "K"
zenkakuAlpha(11) = "L"
zenkakuAlpha(12) = "M"
zenkakuAlpha(13) = "N"
zenkakuAlpha(14) = "O"
zenkakuAlpha(15) = "P"
zenkakuAlpha(16) = "Q"
zenkakuAlpha(17) = "R"
zenkakuAlpha(18) = "S"
zenkakuAlpha(19) = "T"
zenkakuAlpha(20) = "U"
zenkakuAlpha(21) = "V"
zenkakuAlpha(22) = "W"
zenkakuAlpha(23) = "X"
zenkakuAlpha(24) = "Y"
zenkakuAlpha(25) = "Z"
zenkakuAlpha(26) = "a"
zenkakuAlpha(27) = "b"
zenkakuAlpha(28) = "c"
zenkakuAlpha(29) = "d"
zenkakuAlpha(30) = "e"
zenkakuAlpha(31) = "f"
zenkakuAlpha(32) = "g"
zenkakuAlpha(33) = "h"
zenkakuAlpha(34) = "i"
zenkakuAlpha(35) = "j"
zenkakuAlpha(36) = "k"
zenkakuAlpha(37) = "l"
zenkakuAlpha(38) = "m"
zenkakuAlpha(39) = "n"
zenkakuAlpha(40) = "o"
zenkakuAlpha(41) = "p"
zenkakuAlpha(42) = "q"
zenkakuAlpha(43) = "r"
zenkakuAlpha(44) = "s"
zenkakuAlpha(45) = "t"
zenkakuAlpha(46) = "u"
zenkakuAlpha(47) = "v"
zenkakuAlpha(48) = "w"
zenkakuAlpha(49) = "x"
zenkakuAlpha(50) = "y"
zenkakuAlpha(51) = "z"
oSheet = ThisComponent.getCurrentController().getActiveSheet()
oRange = ThisComponent.getCurrentSelection()
For i = 0 To oRange.getRows().getCount() - 1
For j = 0 To oRange.getColumns().getCount() - 1
oCell = oRange.getCellByPosition(j, i)
sText = oCell.getString()
result = ""
' 全角数字と半角数字を漢数字に変換、ハイフンを変換、半角アルファベットを全角に変換
Dim k As Integer
For k = 1 To Len(sText)
Dim ch As String
ch = Mid(sText, k, 1)
Select Case ch
Case "0", "0"
result = result & kansuji(0)
Case "1", "1"
result = result & kansuji(1)
Case "2", "2"
result = result & kansuji(2)
Case "3", "3"
result = result & kansuji(3)
Case "4", "4"
result = result & kansuji(4)
Case "5", "5"
result = result & kansuji(5)
Case "6", "6"
result = result & kansuji(6)
Case "7", "7"
result = result & kansuji(7)
Case "8", "8"
result = result & kansuji(8)
Case "9", "9"
result = result & kansuji(9)
Case "-", "-"
result = result & "ー"
Case "A" To "Z"
result = result & zenkakuAlpha(Asc(ch) - Asc("A"))
Case "a" To "z"
result = result & zenkakuAlpha(Asc(ch) - Asc("a") + 26)
Case Else
result = result & ch
End Select
Next k
oCell.setString(result)
Next j
Next i
End Sub
設定方法なのですが、うちはExcelではなくLibre Calcを使っちゃってますので、こちらで説明させてください。すみません。
ツール→マクロ→マクロの管理→Basic→マイマクロ→Standard→Module1→編集
Subなんとかみたいなのは全部消しちゃって、「REM ***** BASIC *****」の下に上記のマクロを貼り付ける
もし他のマクロがあれば、そのマクロの最後の行の「End sub」の下から貼り付ける保存(フロッピーマーク)する
(ここまでがマクロの登録 ここから下は実行作業)対象のセルを選択する
ツール→マクロ→マクロの実行→マイマクロ→Standard→Module1→SuujiWoKansuujiHaihunWoTateni
実行
最後に
英語と数字とハイフンだけを変換するという尖った内容になっていますが、どこかに刺さっちゃいましたら一度見てやってください。
賢人がやればもっとちゃんとした物が作れるとは思うので、アレンジするのもありかもです。
この記事が気に入ったらサポートをしてみませんか?