【ExcelVBA】セルに設定されたふりがなを一括削除するマクロ

データを並び替える際、Excelは「ふりがな」順を優先するため、
稀に同じデータでも違う場所に並び変わってしまうことがあります。

ふりがなによるソートの不整合

システムから吐き出したデータにはフリガナがありませんが、
そのあと手入力で追加したデータにはフリガナが入ってしまいますからね。

この状態を解消するにはデータすべてからフリガナを消すより他ありませんが、
その機能がExcelにはありませんのでマクロで作ってしまいましょう。

実行型の便利マクロですので、
Excel起動時に裏で開かれる「個人用マクロブック」などに搭載して使ってください。

ショートカットキーに登録したり、ツールバーやリボンにボタン配置すると便利です。

ソースコード
解説
改良版

ソースコード

Sub ふりがなを削除する()
    Dim 対象セル As Range
    For Each 対象セル In Selection
        対象セル.Characters.PhoneticCharacters = ""
    Next
End Sub

解説

非常にシンプルなコードで済みますね。

ふりがなの削除はセル範囲に一括実行できませんので、
For Each文を回して1セルずつ実行します。

フリガナの削除自体は簡単で、

セル.Characters.PhoneticCharacters = ""

で実行が可能です。

改良版

上記のコードだけでもマクロとしては問題ありませんが、
このマクロは「行・列全体」を選択して実行すると少し固まってしまいます。

104万行すべてで実行してしまいますからね。

この手の選択範囲(Selection)に実行するタイプのマクロは、
実行前にUsedRangeを使ってSelectionを縮小するのがおすすめです。

Sub ふりがなを削除する()
    Dim 対象範囲 As Range
    Set 対象範囲 = 選択範囲をUsedRangeで切り取って縮小する
    Dim 対象セル As Range
    For Each 対象セル In 対象範囲
        対象セル.Characters.PhoneticCharacters = ""
    Next
End Sub

' 全体選択のSelectionを縮小
Function 選択範囲をUsedRangeで切り取って縮小する() As Range
    
    ' 行全体・列全体・シート全体が選択されている場合は、
    ' UsedRangeで切り取った範囲を選択しなおし
    If Selection.Address = Selection.EntireRow.Address _
    Or Selection.Address = Selection.EntireColumn.Address Then
        Set 選択範囲をUsedRangeで切り取って縮小する _
            = Intersect(Selection, ActiveSheet.UsedRange)
        選択範囲をUsedRangeで切り取って縮小する.Select
    
    ' それ以外はそのまま
    Else
        Set 選択範囲をUsedRangeで切り取って縮小する = Selection
    End If

End Function