「会社名+店名」を半角カナに変換するマクロ 大体2時間位、色々参考にしたけどエラーチェック無しです ---------------------------------------- Sub setPhoenoetic() '置換したい文字列 Const TARGET = "カブシキ" Const AFTER = "" '開始セルと終了セル Dim targetCell As String targetCell = InputBox("カナに変換したいセルの範囲を入力", Default:="D35:E20000") '変換対象の開始セルと終了セル Dim afterCell As String afterCell = InputBox("カナ変換後セルの範囲を入力", Default:="J35:J20000") '振り仮名を振ってセルを結合 Range(targetCell).Select Dim i As Long For i = Selection(1).Row To Selection(Selection.Count).Row Cells(i, 10).Value = Trim(Application.GetPhonetic(Cells(i, 4).Value)) & " " & _ Trim(Application.GetPhonetic(Cells(i, 5).Value)) Next '半角に変換しカブシキを削除する Range(afterCell).Select For i = Selection(1).Row To Selection(Selection.Count).Row Cells(i, 10).Value = StrConv(Replace(Cells(i, 10).Value, TARGET, AFTER), vbNarrow) Next MsgBox ("end") End Sub

「会社名+店名」を半角カナに変換するマクロ 大体2時間位、色々参考にしたけどエラーチェック無しです ---------------------------------------- Sub setPhoenoetic...
=======================================

「会社名+店名」を半角カナに変換するマクロ
大体2時間位、色々参考にしたけどエラーチェック無しです
----------------------------------------

Sub setPhoenoetic()
'置換したい文字列
Const TARGET = "カブシキ"
Const AFTER = ""

'開始セルと終了セル
Dim targetCell As String
targetCell = InputBox("カナに変換したいセルの範囲を入力", Default:="D35:E20000")

'変換対象の開始セルと終了セル
Dim afterCell As String
afterCell = InputBox("カナ変換後セルの範囲を入力", Default:="J35:J20000")

'振り仮名を振ってセルを結合
Range(targetCell).Select
Dim i As Long
For i = Selection(1).Row To Selection(Selection.Count).Row
Cells(i, 10).Value = Trim(Application.GetPhonetic(Cells(i, 4).Value)) & " " & _
Trim(Application.GetPhonetic(Cells(i, 5).Value))
Next

'半角に変換しカブシキを削除する
Range(afterCell).Select
For i = Selection(1).Row To Selection(Selection.Count).Row
Cells(i, 10).Value = StrConv(Replace(Cells(i, 10).Value, TARGET, AFTER), vbNarrow)
Next

MsgBox ("end")

End Sub

http://ift.tt/1abnmbU
August 30, 2017 at 11:24AM