vbaで漢字をカタカナにするマクロを組みました。一覧のシートをループ->変換テーブルをループ->その文字列が含まれていたら変換するという形です。 Sub 変換() Dim i A...

@porporaposted at 2020-10-30

vbaで文字列内に特定の値が含まれていたら変換する

Q&A

vbaで漢字をカタカナにするマクロを組みました。
一覧のシートをループ->変換テーブルをループ->その文字列が含まれていたら変換するという形です。

Sub 変換()
Dim i As Long
Dim num As Long
Dim num_2 As Long
Dim moji As String
Dim j As Long
'商品一覧のシートを回す
num = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To num
    '半角大文字にする
    moji = StrConv(Sheets(1).Range("B" & i), vbUpperCase)
    moji = StrConv(moji, vbNarrow)

    '変換テーブルの中身をループする
    For j = 2 To Sheets("変換テーブル").Cells(Rows.Count, 1).End(xlUp).Row
        If InStr(moji, Sheets("変換テーブル").Cells(j, 1)) > 0 Then
            moji = Replace(moji, Sheets("変換テーブル").Cells(j, 1), Sheets("変換テーブル").Cells(j, 2))
        End If
    Next

    If InStr(moji, "CLAZZIO ") > 0 Then
        Sheets(1).Cells(i, 3) = moji
    ElseIf InStr(moji, "CLAZZIO") > 0 Then
        Sheets(1).Cells(i, 3) = Replace(moji, "CLAZZIO", "CLAZZIO ")
    Else
        Sheets(1).Cells(i, 3) = "CLAZZIO " & moji
    End If
Next

MsgBox "変換完了しました"
End Sub

しかし、このマクロだと50000件を超えるデータを処理すると時間がかかってしまいます。
何か時間短縮を出来るいい方法などございますか？

ちなみに1枚目のシートは一覧(B列に変換前の商品名が入っている)
変換テーブルという名前のシートのA列に変換前の漢字(例:列目)が入っており、B列に変換後のカタカナ(例:ﾚﾂﾒ)が灰っています。
また、変換テーブルの値と一覧の値は増減します。

2Answer

@takahasinaoki posted at 2020-10-30

以下の記事を参考に

https://excel-ubara.com/excelvba1/EXCELVBA414.html
http://officetanaka.net/excel/vba/speed/s11.htm

セルの値を毎度取得するのではなく
セルの値を一度２次元のバリアント配列に格納して、その変数に対してＬＯＯＰをさせてあげれば高速になるのではないでしょうか？

提示されたコードの
Sheet1のB列
変換テーブルのAB列
Sheet1のC列（結果の列）
をそれぞれバリアント配列に設定して処理します

Dim AB列 As Variant
Dim B列 As Variant
Dim C列 As Variant

num = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
num_2 = Sheets("変換テーブル").Cells(Rows.Count, 1).End(xlUp).Row

B列 = Sheets(1).Range("B2:B" & num)
AB列 = Sheets("変換テーブル").Range("A2:B" & num_2)
C列 = B列

外側のForは以下の要領でLoopさせ値にアクセスします

For i = LBound(B列, 1) To UBound(B列, 1)
    Debug.Print B列(i, 1)
    'C列(i,1) = なんとか
Next

内側のForは以下の要領でLoopさせ値にアクセスします

For j = LBound(AB列, 1) To UBound(AB列, 1)
    Debug.Print AB列(j, 1) , AB列(j, 2)
Next

最後にC列の値をセルに設定します

Sheets(1).Range("C2:C" & num) = C列

さらに、内側のＬＯＯＰ部分のシーケンシャルサーチをバイナリサーチに変更すると劇的な高速化が期待できると思います。
前提として変換テーブルのA列が昇順にソートされていることとなります。
ソートされていない場合は、バリアント配列の AB列を内部的にソートしても同じ結果になります。
※office365のEXCELならばWorksheetFunction.Sort関数でソートできるようです。
バイナリサーチにはWorksheetFunction.VLookup関数を使用します。
要領は以下のようになります

str = WorksheetFunction.VLookup("検索文字列", AB列, 2, 1)
'VLookup関数は、対象文字列がなかった場合は直近の行の値を返すので、hitしたかどうか判定が必要
If AB列(y, 1) = str Then
    '検索文字列が存在した時
    moji = Replace(moji, AB列(y, 1), AB列(y, 2))
Else
    '検索文字列が存在しなかった時
End If

1Like

@jinoji posted at 2020-10-31

変換テーブルでReplaceするときに、事前にInStrする必要あります？


    '変換テーブル
    Dim Htbl As Variant
    Htbl = Sheets("変換テーブル").UsedRange.Value
    
    '商品一覧
    Dim Syohin As Range, Stbl As Variant
    Set Syohin = Intersect(Sheets(1).Columns("B"), Sheets(1).UsedRange)
    Stbl = Syohin.Value
    
    '変換結果
    Dim Kana As Range, Ktbl As Variant
    Set Kana = Syohin.Offset(, 1)
    Ktbl = Kana.Value
    
    Dim i, j, moji
    For i = 2 To UBound(Stbl)
    '変数に移す
        moji = Stbl(i, 1)
    '半角大文字にする
        moji = StrConv(moji, vbUpperCase)
        moji = StrConv(moji, vbNarrow)
    '変換テーブルをループして置換
        For j = 2 To UBound(Htbl)
            moji = Replace(moji, Htbl(j, 1), Htbl(j, 2))
        Next j
    'CLAZZIO処理
        If Not InStr(moji, "CLAZZIO") > 0 Then
            moji = "CLAZZIO " & moji
        ElseIf Not InStr(moji, "CLAZZIO ") > 0 Then
            moji = Replace(moji, "CLAZZIO", "CLAZZIO ")
        End If
    '変換結果用の配列に格納
        Ktbl(i, 1) = moji
    Next i
    
    '変換結果をシートに反映
    Kana.Value = Ktbl
    
    'Msg
    MsgBox "変換完了しました"

1Like

Are you sure you want to delete the question?

vbaで文字列内に特定の値が含まれていたら変換する

2Answer

Your answer might help someone💌