none
セルの関数内で使用している文字列の英数カナを半角にしたい RRS feed

  • 質問

  • セルに
    =関数("文字列",シート1!A1)
    のように関数があるシートがあります。
    (関数、文字列と参照先はセルによってバラバラです)

    この関数の文字列の部分だけを半角(英数字とカナ)にし、
    セル参照のシート名はそのままにすることはできませんでしようか?

    上司かシートに記入してある文字をすべて半角にできるものは
    半角にしろと言われていて、置換ではやってられないので、
    マクロに一気に処理したいのです。
    直接文字が入力してあるだけのセルはValueをStrConvで変換すればよいのですが、
    関数のセルのFormulaLocalをStrConvで変換すると、
    参照している範囲の名称やシートの名前まで変換されて関数がエラーとなってしまい
    困っています。

    2018年4月24日 2:58

回答

  • 以下を参考にしてとりあえず作ってみました。

    正規表現を利用して半角カナを全角に変換する(RegExpオブジェクト)
    http://www.moug.net/tech/exvba/0140015.html

    Sub test()
    
        Dim c As Range
        Dim myStr As String
        Dim Match As Object, Matches As Object
        
        With CreateObject("VBScript.RegExp")
            .Pattern = """([^,]*)([ア-ン]+)([^,]*)""" 'ダブルクオーティション内のカタカナ
            .Global = True
            
            For Each c In ActiveSheet.UsedRange
                
                myStr = c.FormulaLocal
                
                If Len(myStr) > 0 Then
                    Set Matches = .Execute(myStr)
                    
                    'マッチしたすべての文字列を置換
                    For Each Match In Matches
                        myStr = Replace(myStr, Match.Value, _
                                StrConv(Match.Value, vbNarrow))
                    Next Match
                    
                    c.FormulaLocal = myStr
                End If
            Next c
        End With
    
    End Sub
    (追記)
    上記のマクロで変更すると元に戻せなくなりますから、実行する前にバックアップを必ず取って下さい。


    ★良い回答には質問者は回答済みマークを、閲覧者は投票を!


    2018年4月24日 6:47
    モデレータ

すべての返信

  • 以下の命令を組み合わせて、変換範囲を全体文字列ではなく、第一引数の部分文字列に絞って抜き出して置換、最後に前後を結合し直してセットし直す。という流れのプログラムを作成すれば、実現できるのではないかと思いました(未検証)。


    半角変換:StrConv
    文字列分割:Mid, InStr, Left

    =関数("文字列",シート1!A1)


    ↓分割


    =関数(
    "文字列"   ←ここだけ置換
    ,シート1!A1)


    ↓結合


    =関数("変換後文字列",シート1!A1)
    2018年4月24日 4:15
  • 以下を参考にしてとりあえず作ってみました。

    正規表現を利用して半角カナを全角に変換する(RegExpオブジェクト)
    http://www.moug.net/tech/exvba/0140015.html

    Sub test()
    
        Dim c As Range
        Dim myStr As String
        Dim Match As Object, Matches As Object
        
        With CreateObject("VBScript.RegExp")
            .Pattern = """([^,]*)([ア-ン]+)([^,]*)""" 'ダブルクオーティション内のカタカナ
            .Global = True
            
            For Each c In ActiveSheet.UsedRange
                
                myStr = c.FormulaLocal
                
                If Len(myStr) > 0 Then
                    Set Matches = .Execute(myStr)
                    
                    'マッチしたすべての文字列を置換
                    For Each Match In Matches
                        myStr = Replace(myStr, Match.Value, _
                                StrConv(Match.Value, vbNarrow))
                    Next Match
                    
                    c.FormulaLocal = myStr
                End If
            Next c
        End With
    
    End Sub
    (追記)
    上記のマクロで変更すると元に戻せなくなりますから、実行する前にバックアップを必ず取って下さい。


    ★良い回答には質問者は回答済みマークを、閲覧者は投票を!


    2018年4月24日 6:47
    モデレータ
  • ありがとうございます。

    VBSの正規表現を使えば良かったのですね。とても助かりました。

    下記のようにしてできました。

    Sub 半角変換()
        Dim Sht As Worksheet
        Set Sht = ActiveSheet
        Dim rTarget As Range, strChr As String, iCnt As Integer, iChrCnt As Integer
        
        Dim myStr As String
        Dim Match As Object, Matches As Object
    
        For Each rTarget In Sht.UsedRange
            If Not IsEmpty(rTarget) Then
                '数式セルの処理
                If rTarget.HasFormula Then
                    With CreateObject("VBScript.RegExp")
                        .Pattern = """([^,]*)([ア-ン]+)([^,]*)""" 'ダブルクオーティション内のカタカナ
                        .Global = True
                        '数式・パターンマッチのオブジェクトを取得
                        myStr = rTarget.FormulaLocal
                        Set Matches = .Execute(myStr)
                        'マッチしたすべての文字列を置換
                        For Each Match In Matches
                            myStr = Replace(myStr, Match.Value, _
                                    StrConv(Match.Value, vbNarrow))
                        Next Match
                        '置換後の数式を戻す
                        rTarget.FormulaLocal = myStr
                    End With
                
                '数式ではないセルの処理
                Else
                    'セルの文字数を取得
                    iChrCnt = rTarget.Characters.Count
                    'セル内のフォント書式を保つため、1文字ずつ文字だけ変換
                    For iCnt = 1 To iChrCnt
                       With rTarget.Characters(Start:=iCnt, Length:=1)
                            'チルダを除いて処理
                            If .Text <> "~" Then
                                .Text = StrConv(.Text, vbNarrow)
                            End If
                       End With
                    Next
                    
                End If
            End If
        Next
        
    End Sub

    2018年4月25日 1:58
  • ありがとうございます。

    使っている関数が色々あるため、引数の位置も一定ではないのです。

    質問の例が分かりにくかったです。申し訳ございません。

    trapemiyaさんの回答を参考に解決しました。

    2018年4月25日 2:03