Excel VBA全角半角変換：自動化スクリプトとマクロ作成

StrConv(string, conversion, [LCID])

Sub BasicZenkakuToHankaku()
    Dim inputText As String
    Dim outputText As String

    ' 変換対象の文字列
    inputText = "１２３ＡＢＣアイウ"

    ' 全角→半角変換（英数字のみ）
    outputText = StrConv(inputText, vbNarrow)

    ' 結果を表示
    Debug.Print "変換前: " & inputText
    Debug.Print "変換後: " & outputText
    ' 出力: 123ABCアイウ
End Sub

Sub ConvertSelectedRange()
    Dim cell As Range
    Dim selectedRange As Range

    ' 選択範囲を取得
    Set selectedRange = Selection

    ' エラーハンドリング
    If selectedRange Is Nothing Then
        MsgBox "範囲を選択してください。"
        Exit Sub
    End If

    ' 各セルを処理
    For Each cell In selectedRange
        If Not IsEmpty(cell.Value) Then
            ' 全角→半角変換
            cell.Value = StrConv(cell.Value, vbNarrow)
        End If
    Next cell

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

Function ConvertAlphaNumericOnly(inputText As String) As String
    Dim i As Integer
    Dim char As String
    Dim result As String

    result = ""

    For i = 1 To Len(inputText)
        char = Mid(inputText, i, 1)

        ' 全角英数字かチェック
        If (Asc(char) >= Asc("Ａ") And Asc(char) <= Asc("Ｚ")) Or _
           (Asc(char) >= Asc("ａ") And Asc(char) <= Asc("ｚ")) Or _
           (Asc(char) >= Asc("０") And Asc(char) <= Asc("９")) Then
            ' 全角英数字の場合は半角に変換
            result = result & StrConv(char, vbNarrow)
        Else
            ' その他の文字はそのまま
            result = result & char
        End If
    Next i

    ConvertAlphaNumericOnly = result
End Function

Sub ConvertEntireWorkbook()
    Dim ws As Worksheet
    Dim cell As Range
    Dim usedRange As Range
    Dim startTime As Double
    Dim endTime As Double
    Dim processedCells As Long

    ' 処理開始時間を記録
    startTime = Timer
    processedCells = 0

    ' 画面更新を停止（高速化）
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' 各ワークシートを処理
    For Each ws In ThisWorkbook.Worksheets
        Set usedRange = ws.UsedRange

        If Not usedRange Is Nothing Then
            For Each cell In usedRange
                If Not IsEmpty(cell.Value) And VarType(cell.Value) = vbString Then
                    cell.Value = StrConv(cell.Value, vbNarrow)
                    processedCells = processedCells + 1
                End If
            Next cell
        End If
    Next ws

    ' 設定を元に戻す
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

    ' 処理時間を計算
    endTime = Timer

    ' 結果を表示
    MsgBox "変換完了！" & vbCrLf & _
           "処理セル数: " & processedCells & vbCrLf & _
           "処理時間: " & Format(endTime - startTime, "0.00") & "秒"
End Sub

Sub ProcessCSVFiles()
    Dim folderPath As String
    Dim fileName As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim cell As Range

    ' フォルダパスを指定
    folderPath = "C:\Data\"

    ' フォルダ内のCSVファイルを処理
    fileName = Dir(folderPath & "*.csv")

    Do While fileName <> ""
        ' CSVファイルを開く
        Set wb = Workbooks.Open(folderPath & fileName)
        Set ws = wb.Sheets(1)

        ' データを変換
        For Each cell In ws.UsedRange
            If Not IsEmpty(cell.Value) And VarType(cell.Value) = vbString Then
                cell.Value = StrConv(cell.Value, vbNarrow)
            End If
        Next cell

        ' ファイルを保存して閉じる
        wb.Save
        wb.Close

        ' 次のファイルへ
        fileName = Dir
    Loop

    MsgBox "すべてのCSVファイルの処理が完了しました。"
End Sub

Sub FastArrayConversion()
    Dim ws As Worksheet
    Dim dataRange As Range
    Dim dataArray As Variant
    Dim i As Long, j As Long
    Dim startTime As Double

    Set ws = ActiveSheet
    Set dataRange = ws.UsedRange

    ' 開始時間を記録
    startTime = Timer

    ' 画面更新を停止
    Application.ScreenUpdating = False

    ' データを配列に読み込み
    dataArray = dataRange.Value

    ' 配列内でデータを変換
    For i = 1 To UBound(dataArray, 1)
        For j = 1 To UBound(dataArray, 2)
            If VarType(dataArray(i, j)) = vbString Then
                dataArray(i, j) = StrConv(dataArray(i, j), vbNarrow)
            End If
        Next j
    Next i

    ' 変換後のデータを一括でシートに書き戻し
    dataRange.Value = dataArray

    ' 画面更新を再開
    Application.ScreenUpdating = True

    ' 処理時間を表示
    Debug.Print "処理時間: " & Format(Timer - startTime, "0.00") & "秒"
End Sub

Sub SafeConversionWithErrorHandling()
    Dim cell As Range
    Dim selectedRange As Range
    Dim errorCount As Long
    Dim successCount As Long

    On Error GoTo ErrorHandler

    ' 選択範囲の確認
    If Selection Is Nothing Then
        MsgBox "範囲を選択してください。", vbExclamation
        Exit Sub
    End If

    Set selectedRange = Selection
    errorCount = 0
    successCount = 0

    ' 各セルを安全に処理
    For Each cell In selectedRange
        On Error Resume Next

        If Not IsEmpty(cell.Value) And VarType(cell.Value) = vbString Then
            Dim originalValue As String
            Dim convertedValue As String

            originalValue = cell.Value
            convertedValue = StrConv(originalValue, vbNarrow)

            If Err.Number = 0 Then
                cell.Value = convertedValue
                successCount = successCount + 1
            Else
                errorCount = errorCount + 1
                Debug.Print "エラー発生: セル " & cell.Address & " - " & Err.Description
                Err.Clear
            End If
        End If

        On Error GoTo ErrorHandler
    Next cell

    ' 結果を報告
    MsgBox "変換完了" & vbCrLf & _
           "成功: " & successCount & " セル" & vbCrLf & _
           "エラー: " & errorCount & " セル"

    Exit Sub

ErrorHandler:
    MsgBox "予期しないエラーが発生しました: " & Err.Description, vbCritical
    Err.Clear
End Sub

Function CustomConvert(inputText As String, conversionType As String) As String
    Dim result As String

    Select Case UCase(conversionType)
        Case "ALPHANUMERIC"
            ' 英数字のみ半角変換
            result = ConvertAlphaNumericOnly(inputText)

        Case "NUMERIC"
            ' 数字のみ半角変換
            result = ConvertNumericOnly(inputText)

        Case "KATAKANA"
            ' カタカナのみ全角変換
            result = ConvertKatakanaToZenkaku(inputText)

        Case "ALL"
            ' すべて半角変換
            result = StrConv(inputText, vbNarrow)

        Case Else
            result = inputText
    End Select

    CustomConvert = result
End Function

Private Function ConvertNumericOnly(inputText As String) As String
    Dim i As Integer
    Dim char As String
    Dim result As String

    result = ""

    For i = 1 To Len(inputText)
        char = Mid(inputText, i, 1)

        If Asc(char) >= Asc("０") And Asc(char) <= Asc("９") Then
            result = result & StrConv(char, vbNarrow)
        Else
            result = result & char
        End If
    Next i

    ConvertNumericOnly = result
End Function