Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Excel 2013)
環境依存文字を置換したい
投稿日時: 20/11/23 10:57:45
投稿者: kawata

よろしくお願いします。
 
ワークシートに作成している住所録の氏名列に対して環境依存文字が
入力された場合に、ワークシートイベントでもって、環境依存文字を
通常の第1水準、第2水準の漢字に置き換えています。
※置き換える環境依存文字は、別途ワークシート「置換文字一覧」に
 あり、掲載されていない環境依存文字は「_」に置き換えるルール
 です。
 
で、問題としているのが・・・・・
環境依存文字の有無をチェックして環境依存文字が存在すれば、置換と
していますが、一部の環境依存文字では、おかしな現象が発生します。
※置換と書きましたが、変更した文字に対して、書式属性(色・強調等)
 を変更している関係から、Replaceでなく1文字ずつばらしては結合と
 いう方法にしています。
 
「辻󠄀田」を「辻田」にしたくても、置換すれば「辻 田」となり、
不明なスペースが入ってきます。「𦚰」でも同様です。
「辻󠄀」(いってんしんにょうのつじ)
「𦚰」(かたな3つのわき)
※他にもあります、すべては調べきれていませんが。
 
でいろいろ戻り値をチェックしていたら、環境依存文字によっては、
Lenで返る値が相違していました。
大半は1が返りますが、上の「辻󠄀」の場合は3、「𦚰」の場合は2と。
これが原因だろうと思いますが、その後の処理に多々不具合が・・。
 
この置換した後の不明のスペースを削除する方法を知りたいのです。
 
※ちなみに「辻 田」となった場合、セル編集で「 」をハンドで
 削除すると「辻」も消えて「田」しか残りません。
 
お手数おかけします、ご教示よろしくお願いします。

回答
投稿日時: 20/11/23 19:06:45
投稿者: simple

たしかに、Lenが3を返しますね。
少し前に、S.Kosさんが質問されていたVBAのLen関数の不備(localizationが不十分?)でしょうね。
 
ところで、

引用:
「辻󠄀田」を「辻田」にしたくても、置換すれば「辻 田」となり、
不明なスペースが入ってきます。
というのは、
具体的にどのように実行されていますか?
それを書いていただくと、コメントがつく可能性が高まると思います。
 
・できるだけワークシート上の情報をそのまま使う。
・文字列の位置を指定するような指定を避ける
ことで、対応できないですかね。

投稿日時: 20/11/24 19:41:05
投稿者: kawata

ご教示ありがとうございます。
 
さて・・・コードを掲示とのご指示ですが、これがとても
厄介です、職場で作成したコードを持って帰る手段があり
ません、なので唯一の方法であるプリントアウトで持って
帰りました。
※マクロのそのものは勿論自身がゼロベースで作成しています。
 ただし環境依存の定義はネットで探したものを使わせて
 もらってます。
 
自宅のPCで打ち直してから再度アップさせていただきます、が、
時間が・・・・・・・・・・・。
 
>・できるだけワークシート上の情報をそのまま使う。
>・文字列の位置を指定するような指定を避ける
 
まさに、これだとは思うのですが、それを抜きにして、なら
どうすれば?というつもりで質問させていただきました。
※Replaceであればスペース云々の問題は出ません、ただ
 置き換えた文字の属性を設定するところで無理だと判断
 している次第です。
 
例えば、
「辻󠄀辻 太郎」とあった場合に、Replaceだと問題なく
「辻辻 太郎」とできます、そのあと1文字目の「辻󠄀」
を捉えられなくて・・・。
で、いま作成している方法だと、
「辻 辻 太郎」となっているわけです。

回答
投稿日時: 20/11/24 19:56:15
投稿者: simple

コード全体ということでなく、どういう処理をしているかを説明されては?
ということです。無理なら仕方ないですね。
 
それで、

引用:
「辻󠄀辻 太郎」とあった場合に
どうするのがゴールなんですか?

投稿日時: 20/11/24 20:16:09
投稿者: kawata

「辻󠄀辻 太郎」とあった場合に
「辻辻 太郎」と修正し、なおかつ、「辻 太郎」としたいのです。
「辻󠄀」「𦚰」などを除き、Lenでの返り値が1の場合の環境依存文字で
あれば目的を達成しています。
 
とりあえず、ご返事のみ。

回答
投稿日時: 20/11/24 21:24:40
投稿者: simple

混乱するので、
● 一点しんにょうのツジ
○ 通常の辻
と書くことにします。
 
●○を
○○にする(ただし最初の○だけ赤色フォント)
ということですか?
 
一回、○○にしてしまえば、
書式付き置換を適用して、
○○を
○○(ただし最初の○は赤色フォント)
にするのは、通常の、Lenが1のものなので普通にできるのでは?

回答
投稿日時: 20/11/25 08:30:33
投稿者: WinArrow
投稿者のウェブサイトに移動

問題となっているのは、
>機種依存文字
ではなく
サロゲートペア文字
という文字だと思います。
 
参考
ワークシートに
変換前文字列列と変換後文字列の変換表を作成します。

A2  B2
辻󠄀    辻
※↑一点しんにょう
 
D2に対象文字列
辻󠄀田 太郎
 
コード例(D2の右隣に変換後文字列を格納します)

Sub test()
Dim HTBL As Range, H As Long
Dim 文字 As Range
Dim L As Long

    Set HTBL = Range("A2:B2")
    Set 文字 = Range("D2")
    For L = 1 To LenB(文字) Step 2
        For H = 1 To HTBL.Rows.Count
            If MidB(文字.Value, L, 4) = LeftB(HTBL(H, "A").Value, 4) Then
                文字.Offset(, 1).Value = 文字.Offset(, 1).Value & HTBL.Cells(H, 2)
                L = L + 4
            Else
                文字.Offset(, 1).Value = 文字.Offset(, 1).Value & MidB(文字, L, 2)
            End If
        Next
    Next
    
End Sub

※ミソ
Len,Mid
ではなく
LenB,MidB
を使います。
 
 
 

回答
投稿日時: 20/11/25 09:38:46
投稿者: WinArrow
投稿者のウェブサイトに移動

追伸
↑のコードは、
 変換表に存在する文字を検索するのみで、
サロゲートペア文字を判断するコードではありません。
 従って
>変換表に存在しない場合は、「_」に置き換え
 には対応していません。
 
サロゲートペア文字を判断する方法は、
 
サロゲートペア文字を判断する VBS
などのキーワードで検索すれば、
参考コードが得られます。
 

投稿日時: 20/11/25 18:48:44
投稿者: kawata

ありがとうございます、取り急ぎお礼まで。
 
ご教示の、サロゲートペア文字(初めて聞く言葉です)を
調べてみます。
 
こうなってきますと是非に解決に繋げたい気持ちです、
ワクワクしてきます、ありがとうごいざいました。
 
※今日は朝から、マクロ記録でのReplace、Replaceformatで
 ああだこうだとやっていました。
 
時間がかかると思います、申し訳ないですがご了承よろしく
お願いします。
 
 

回答
投稿日時: 20/11/25 22:26:39
投稿者: MMYS

今回のケースは「異体字セレクタ」です。
 
「サロゲートペア」「異体字セレクタ」を理解するは、
UNICODEの目的や歴史の理解が必要です。
 
 
Unicodeとは? その歴史と進化、開発者向け基礎知識
https://www.buildinsider.net/language/csharpunicode/01
 
詳細は上記をご覧ご覧いただくとして、重要なことは
 
>コンピューターのハードウェア的な制約が大きく、文字数を絞らざるを得なかった。
>日常でよく使われる漢字を「第1水準漢字」(2965文字)、
>人名や地名のみで使う珍しい漢字や旧字体を「第2水準漢字」(3384文字)
>第2水準でもかなり絞った結果である。

 
つまり、本来必要な漢字が全然足りないのです。
 

>日本の漢字は第1水準、第2水準合わせて6000文字程度だ。
>これはコンピューターの性能的な理由で絞った数であり、もし「入れてもいい」といわれればもっと増えるものである。
> <中略>
>当然、3万文字の余裕など一瞬にしてなくなった。

 
当初、世界中の文字は6万文字で足りると思ってたけど、文字の追加に全然足りないとなって、「サロゲートペア」の登場します。
 

>異字体: 漢字の異字体(=同じ文字・同じ意味と見なされるが字形が異なる文字)の表現に、
>ベースとなる漢字に字形を選択するための文字を付けて表現する。
>この選択用の文字を異字体セレクター(ideographic variation selector)という

 
UNICODEは似た文字は1つの文字で表現します。つまり、似たような文字は、1文字だけが登録されています。
しかし、日本語には「斎藤」の「斉」ように文字に複数のバリエーションある文字が存在します。このような、異体字を表現する方法うのが「異体字セレクタ」
 
 
異体字セレクタ
https://ja.wikipedia.org/wiki/%E7%95%B0%E4%BD%93%E5%AD%97%E3%82%BB%E3%83%AC%E3%82%AF%E3%82%BF
 
普及が期待される新しい仕組み・IVS
https://fontnavi.jp/zakkuri/307-IVS.aspx
 
IVD/IVSとは
http://mojikiban.ipa.go.jp/1292.html
 
 
ところで、そもそもなぜ、文字置き換えをしたいのでしょうか。
つまり、昔はJIS第一、第二しか使えなかったから、しかたなくその文字で代用してました。
しかし、本来、住所、氏名は、その文字が正しい文字だと思うのですが。
 
 

投稿日時: 20/11/26 19:50:12
投稿者: kawata

どうもありがとうございます。
 
紹介されているサイトを一通り覗いてみました。
いまやろうとしていることは、これを理解してから!ということですか。
なんとも、とんでも方向に手を出そうとしているのでしょうか(私)。
 
>ところで、そもそもなぜ、文字置き換えをしたいのでしょうか。
>つまり、昔はJIS第一、第二しか使えなかったから、しかたなくその文字で代用してました。
>しかし、本来、住所、氏名は、その文字が正しい文字だと思うのですが。
 
この件ですが、行政調書を入力するときのルールということです、
申し訳ございませんが、それ以上は、ちょっと困ってしまいます。
すいません。
 
とにかくしばらく、これにかかりっきりになりそうな気がしています。
一旦閉じたほうがいいかも?という気が・・・。
 
※WinArrowさんのコードの動確は完了しました、さて、これを?と考えても
 いまのところサッパリです。
 
とりあえずは、お礼まで。

回答
投稿日時: 20/11/26 20:45:24
投稿者: WinArrow
投稿者のウェブサイトに移動

[quote="kawata"]
 
※WinArrowさんのコードの動確は完了しました、さて、これを?と考えても
 いまのところサッパリです。
 
[quote]
 
あなたのコードを提示しないかぎり、
アドバイスは、難しい・・・・・よ!

回答
投稿日時: 20/11/28 14:50:40
投稿者: mattuwan44

>一旦閉じたほうがいいかも?という気が・・・。
 
ん〜もう少し粘ってみては?
 
やりたいことは大体こういうことだと思うけども、
1文字が2バイトより大きい文字が混ざるとおかしな結果になるということでしょうね。。。
 

Sub test()
    Dim rngCheck As Range   '文字列をチェックするセル範囲
    Dim rngList As Range    '代替文字リストのセル範囲
    Dim c As Range
    
    Set rngCheck = Range("A1:A3")
    Set rngList = Range("D1:E2")
    
    For Each c In rngCheck
     'リストにある文字があれば代替文字で置き換えて、置き換えたことを表示するために赤に表示する。
        chk代替文字 c, rngList  
    Next
End Sub

Sub chk代替文字(ByRef c As Range, ByRef rngList As Range)
    Dim i As Long
    Dim ix As Variant
    Dim s As String
    
    For i = 1 To c.Characters.Count
        With c.Characters(i, 1)
            ix = Application.Match(.Text, rngList, 0)
            If Not IsError(ix) Then
                .Text = rngList(ix, 2).Value
                .Font.Color = vbRed
                .Font.Bold = True
            End If
        End With
    Next
End Sub

 
さてさて、どうしたものか。。。。
 
誰かの参考になれば。。。

回答
投稿日時: 20/11/28 15:34:56
投稿者: WinArrow
投稿者のウェブサイトに移動

 MMYS さん、ご指摘のように
異体字セレクタ
です。
 
異体字セレクタセレクタ
は、「正字体」に枝番を付加したコードで異体字を取り扱うもので、
サロゲートペアの拡張版と考えてもよいのかな?
 
にわか勉強ですが、・・・・
認識が間違っていたら、ご指摘ください。
バイト数で比較すると
半角文字:1バイト
全角文字:2バイト
UNICODE:2バイト
サロゲートペア:4バイト(上位サロゲート:2バイト+下位サロゲート:2バイト)
異体字セレクト:6バイト以上(上位サロゲート:2バイト+異体字セレクタ枝番:4バイト)
 
今回、例示の辻󠄀(一点しんにょう)は、Len関数では、「3」LenB関数では「4」となります。
しかし、
Dim DATA() As Byte
DATA = Range("A1").Value
Msgbox LenB(DATA)
バイト変換すると「6」となります。
Msgbox LenB(DATA)
バイト変換したデータで、話を進めると
今回の「辻󠄀」をHEXで表示すると「8FBB DB40 DD00」になります。
上位サロゲートは、全角文字と同じです。(辻(二点しんにょう)のコードは、8FBBです)
更に、サロゲートペアの下位サロゲートに当たる2バイトは、&HDB40 (固定値)です。
実質的に、枝番は、最後の2バイトが変化する(DD00〜DDFF)形となります。
 
今回の問題は、異体字から正字体を求めるということなので、
サロゲートペア分析後、下位サロゲートに当たる2バイトが「&HDB40」と同じならば
上位サロゲートの文字を取得すればよいのではないでしょうか?
 
異体字セレクトに関する「変換表」は、不要と思います。

回答
投稿日時: 20/11/28 15:47:59
投稿者: WinArrow
投稿者のウェブサイトに移動

引用:
Dim DATA() As Byte
 DATA = Range("A1").Value
 Msgbox LenB(DATA)
バイト変換すると「6」となります。
Msgbox LenB(DATA)
 

前レス投稿したの部分が間違っていました。
↓に置き換えてください。
引用:

Dim DATA As String
Dim H
Dim i As Long
Dim B() As Byte
Dim HMOJI As String
 
    DATA = ActiveCell.Value
    MsgBox LenB(DATA)
    ReDim H(1 To LenB(DATA) / 2)
    For i = LBound(H) To UBound(H)
        B = Mid(DATA, i, 2)
        H(i) = Right("0" & Hex(B(1)), 2) & Right("0" & Hex(B(0)), 2)
    Next
     
    ActiveCell.Offset(, 1).Value = Join(H)

回答
投稿日時: 20/11/28 17:58:27
投稿者: mattuwan44

質問を乗っ取った形になってすみません。
面白いテーマなので、こちらで勉強した結果を共有できればと書き込みます。
 

Sub Set正字体(ByRef c As Range, ByRef rngList As Range)
    Dim i As Long
    Dim b() As Byte
    Dim s As String
    Dim flg As Boolean
    
    For i = 1 To c.Characters.Count
        With c.Characters(i, 1)
            b = .Text
            s = b
            .Text = s
        End With

        If flg Then
            With c.Characters(i - 1, 1)
                .Font.Color = vbRed
                .Font.Bold = True
            End With
            flg = False
        End If
            
        If Len(s) = 0 Then flg = True
    Next
End Sub

 
他の方の回答、理解が難しいですね。
 
>バイト変換すると
どうやってするんだろうって試行錯誤の結果、
変数に代入したら、エクセル君が勝手に変換してくれるという話のようですね?
 
            b = .Text
            s = b
            .Text = s
 
ちょっと乱暴ですが、
これで、「辻󠄀」のほうは、うまくいきましたが、
「𦚰」の方は対応できてないです。
>異体字セレクト:6バイト以上(上位サロゲート:2バイト+異体字セレクタ枝番:4バイト)
こちらの文字と思われます。
4バイトの情報を頭の(?)2バイトに削ぎ落せばよさそうですが、
Dim b() As Byte
と宣言しているときのRedimのやり方がわかりませんでした。
あと、
b = .Text
とやったときの配列かそうでないかの条件分岐も
ちょっとやり方がわかりませんでした。
なんにしても文字列の途中の色を変えるなら、
Charactersプロパティを使わないといけないので、
その辺を調べてみては?
 
コードの意味が解らないときはステップインで実行しながら、変数の中身の変化を観察するといいかもです。
 
なにか分かったら書き込みするかも知れませんが、とりあえずギブアップです。

回答
投稿日時: 20/11/28 20:25:43
投稿者: WinArrow
投稿者のウェブサイトに移動

>「𦚰」の方は対応できてないです。
 
「𦚰」(かたな3つ)は、異字体セレクタ対象の文字ではありません。
 
「脇」(カ3つ)はのHEXは、 8107
「𦚰」(かたな3つ)のHEXは、D859 DEB0
 
従って、変換表が必要なパターンです。
 
 

回答
投稿日時: 20/11/28 20:40:01
投稿者: WinArrow
投稿者のウェブサイトに移動

文字に色をつける場合
Charactersを使うわけですが、
変換前のバイト位置、長さと、変換後のバイト位置、長さが
異なることを理解することです。
 

投稿日時: 20/11/28 21:19:20
投稿者: kawata

ありがとうございます。
質問した本人の理解が、まったく進展しないのに・・・・・、
申し訳ないです。
 
こちらでも作成したコードを再現しました、どうにも職場で作成した
コードと微妙に動作が違って、情けない状況です。
そこへ、新たなコード提供があって、アップするのに気おくれしている
状況です。
 
1.シート「テスト」、シート「置換表」
2.シート「置換表」のA1に「辻󠄀」、B1に「辻」
3.シート「テスト」のA1に「●辻󠄀 ○○」(姓+スペース+名として)
 
結果・・・・「●辻 ○○」です
情けないですが、継続して修正トライします、すいません。
※なんやかやくっつけて作成している部分を清書したような感じです、
 「_」の部分は抜いています。
 
Dim myws As Worksheet
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim t_range As Range
    Set myws = ThisWorkbook.Worksheets("置換表")
    Set t_range = Intersect(Target, Me.Columns(1))
    If Not t_range Is Nothing Then
        With Target.Font
            .Bold = False
            .Color = vbBlack
        End With
        Call 環境依存着色(t_range)
    End If
    Set myws = Nothing
End Sub
 
Sub 環境依存着色(ByVal t_range As Range)
Dim maxlen As Long
Dim c_cnt As Long
Dim char As Variant
Dim searchAarea As Range
    With myws
        Set searchAarea = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp))
    End With
    maxlen = Len(t_range.Value)
     For c_cnt = 1 To maxlen
        char = Mid(t_range.Value, c_cnt, 1)
        If ChkPDChar(char) = 1 Then
            strVal = CStr(char)
            Set f_chr = searchAarea.Find(What:=strVal, LookAt:=xlWhole)
            If f_chr Is Nothing Then
                With t_range.Characters(Start:=c_cnt, Length:=1).Font
                    .Color = vbRed
                    .Bold = True
                End With
            Else
                rep_chr = f_chr.Offset(, 1).Value
                With t_range
                    repV = myrep(t_range.Value, strVal, rep_chr)
                    .Value = repV
                    With .Characters(Start = c_cnt, Length = 1).Font
                        .Color = vbGreen
                        .Bold = True
                    End With
                End With
            End If
        End If
    Next
End Sub

投稿日時: 20/11/28 21:22:18
投稿者: kawata

Function myrep(ByVal tx1 As String, ByVal tx2 As String, ByVal tx3 As String) As String
    myrep = Left$(tx1, InStr(tx1, tx2) - 1) _
        & tx3 & _
        Mid$(tx1, InStr(tx1, tx2) + 1)
End Function
 
     
'↓このFunctionはYahoo知恵袋からいただいてます、コードの
'掲載がまずいのであれば削除しますのでご指摘下さい
Function ChkPDChar(varVal As Variant) As Variant
Dim strVal As String
Dim strChr As String
Dim lngIdx As Long
Dim lngCval As Long
Dim lngLen As Long
Dim lngCp932 As Long
Dim lngUnicode As Long
Dim bolPDCFlg As Boolean
 
    If IsEmpty(varVal) Then
        '//データ無し
        ChkPDChar = CVErr(xlErrNull)
    Else
        strVal = CStr(varVal)
        lngLen = Len(strVal)
        bolPDCFlg = False
        For lngIdx = 1 To lngLen
            strChr = Mid(strVal, lngIdx, 1)
            lngCp932 = Asc(strChr)
            lngUnicode = AscW(strChr)
            If lngUnicode = 63 Then '//?
            '//Nop
            ElseIf lngCp932 >= 0 And lngCp932 <= 62 Then '//JIS X0201
            '//Nop
            ElseIf lngCp932 >= 64 And lngCp932 <= 223 Then '//JIS X0201
            '//Nop
            ElseIf lngCp932 >= -32448 And lngCp932 <= -31554 Then '//JIS X0208
            '//Nop
            ElseIf lngCp932 >= -30561 And lngCp932 <= -26510 Then '//JIS X0208
            '//Nop
            ElseIf lngCp932 >= -26465 And lngCp932 <= -5468 Then '//JIS X0208
            '//Nop
            Else
                bolPDCFlg = True
            End If
        Next
        If bolPDCFlg = False Then
            ChkPDChar = 0
        Else
            ChkPDChar = 1
        End If
    End If
     
End Function

回答
投稿日時: 20/11/28 22:16:29
投稿者: WinArrow
投稿者のウェブサイトに移動

>char = Mid(t_range.Value, c_cnt, 1)
ここで取得した1文字を引数にして
チェックしているだけですよね?
 
見た目1文字でも、内部コードとしては、4バイト(2文字)があったり、6バイトがあったりするので、
それが判定できなければ、何も始まりません。
色付けは、お化粧ですよね?
土台がないところにお化粧はできません。
 
2バイト同士の変換でしたら、内部コードまで落とさなくても
変換表の作り方で3行位のコードで済みますよ!
 
それから、
変換表は、
2バイト文字を2バイト文字に変換するもの
4バイト文字を2バイト文字に変換するもの
6バイト文字を2バイト文字に変換するもの
を考慮する必要が合います。
但し、前レスにも書いておきましたが
6バイト文字(異体字セレクタ)は、変換表が不要だと思います。
 
私は、昔(UNICODE以前)
2バイト文字を2バイト文字に変換するもの
をある名簿管理処理に組み込んであります。

回答
投稿日時: 20/11/28 23:50:13
投稿者: MMYS

Unicodeは1文字が2バイトが原則です。
2バイトで世界中の文字を世界中の文字を表現しようというのがUnicodeの本来の思想です。
そのため、Unicodeはよく似た文字は統合して1文字にまとめる決まりになっています。
 
VBAはこの原則で作られています。しかし、その後仕様変更。VBAは初期の原則にしか対応していません。今回はそれが問題となっています。
 
 
まず、前提として、「サロゲートペア」と「異体字セレクタ」は別物です。
サロゲートペアは本来、6万文字しか表現できない欠点を克服する仕様で、104万文字の表現が可能です。
異体字セレクタ(IVS)は、文字としては同じだけど字形の違いの表現です。
 
 
サロゲートペア入門
https://codezine.jp/article/detail/1592
 
闘うITエンジニアの覚え書き
https://www.magata.net/memo/index.php?%A5%B5%A5%ED%A5%B2%A1%BC%A5%C8%A5%DA%A5%A2
 
 
ところで、Unicodeの表現は
 U+266B0
のように表現します。文字コード番号はワードパットで調べられます。また、Webでも文字コードは調べられます。ただし、リンク先にある通り、実際のバイナリデータは4バイトですから、VBAのHex関数と相違します。
 
WindowsでUnicode文字を簡単に入力したり、Unicodeの文字コード番号を調べたりする方法
https://www.atmarkit.co.jp/ait/articles/1606/22/news051.html
 
Unicodeの異体字操作に便利なツール「異体字セレクタセレクタ」
https://digitalnagasaki.hatenablog.com/entry/2017/01/18/030751
異体字セレクタセレクタ (α v0.5)
https://747.github.io/vsselector/
 

回答
投稿日時: 20/11/28 23:55:30
投稿者: MMYS

WinArrow さんの引用:

認識が間違っていたら、ご指摘ください。
バイト数で比較すると
半角文字:1バイト
全角文字:2バイト

VBAの内部コードはUTF-16です。
半角文字でも、2バイトです。1文字2バイトが原則。
 
 
WinArrow さんの引用:

今回の「辻󠄀」をHEXで表示すると「8FBB DB40 DD00」になります。
<中略>
異体字セレクトに関する「変換表」は、不要と思います。

今回の「辻󠄀」はサロゲートペアではありません。
基底文字が 8FBB 、異体字セレクタは DB40 DD00
なので DB40 DD00 削除すれば良いです。
 
異体字セレクタセレクタ ( https://747.github.io/vsselector/ )で、異体字を入力すると使用文字コードが出ます。緑色部コードだけ削除してみてください。
 
 

回答
投稿日時: 20/11/29 06:15:03
投稿者: simple

こんなことでしょうか。テストコードを書いてみました。
 
■シートなどの前提
 

<<Sheet1>>                |    <<置換表>>
                          |
    A列                   |        A列       B列  
1   辻 太郎              |    1   辻        辻 
                          |                  ↑2点しんにょう
    ↑1点しんにょう       |       ↑1点しんにょう       
                          |
A1セルを
    "辻辻 太郎" に置換するとともに、
    2文字目には置換前の漢字を赤字で表示する。
 
■コードを下記しますが、ポイントは、
(1)置換は、ワークシート上のものだけを使ってReplaceメソッド使用。(VBA側での独自加工はしない)
(2)色を付ける範囲の長さの指定に、Len関数を用いる
の2点です。
 
Sub test()
    Dim ws1     As Worksheet
    Dim ws2     As Worksheet
    Dim rng     As Range
    Dim k       As Long
    Dim s       As String
    Dim repl    As String
    Dim pos     As Long

    Set ws1 = Worksheets("Sheet1")      '■ 必要に応じて修正のこと
    Set ws2 = Worksheets("置換表")      '■ 必要に応じて修正のこと
    
    Set rng = ws1.[A1]  'A1セルだけを対象としたテストです
    
    '変換表で変換
    For k = 2 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
        s = ws2.Cells(k, 1).Value
        pos = InStr(rng.Value, s)
        If pos > 0 Then     '置換対象であれば
            repl = ws2.Cells(k, 2).Value
            rng.Replace s, repl & s, Lookat:=xlPart 
            
            '変換前の文字を赤太字に(なお、一か所だけと仮定しました)
            With rng.Characters(Start:=pos + 1, Length:=Len(s)).Font
                .Color = vbRed
                .Bold = True
            End With
        End If
    Next
End Sub

上記はテストサンプルなので、これを元に応用してください。
 
なお、Changeイベントプロシージャが必要とも思えませんし、
実質的に変更していなくても、F2キーを押してEnterでイベントプロシージャが動きます。
その場合は、置換後の文字が増幅されてしまいます。
コントロールは難しいと思いますので、
ユーザー起動のマクロを推奨します。
 
(なお、イベント処理をどうしてもという場合でも、
  少なくともEnableEventsプロパティを操作して、処理が循環再生しないようにすべきです。)

回答
投稿日時: 20/11/29 10:14:05
投稿者: WinArrow
投稿者のウェブサイトに移動

MMYS さんへ
 
>VBAの内部コードはUTF-16です。
>半角文字でも、2バイトです。1文字2バイトが原則。
そうでしたね。
 
文字コードの歴史という面から書いたつもりです。
説明が抜けていました。
 
  
 

回答
投稿日時: 20/11/29 10:27:51
投稿者: WinArrow
投稿者のウェブサイトに移動

 simple さんへ
 
最後のコードは、変換表からデータ側を検索する方式なんですね・・・
 
私は、データ側の文字を解析して、変換表を検索する
という観点で考えていました。
 
でも、変換表に未登録の文字は検出できないと思います。
 
変換すべき文字がすべて網羅されているとは限りませんので、
データ側から変換表を検索しても、同じかもしれません。
全ての文字を変換表に網羅できれば問題ないが・・・・

回答
投稿日時: 20/11/30 11:17:26
投稿者: simple

コメントありがとうございます。
 
投稿日時: 20/11/28 21:19:20での質問者さんのコードの中に
置換表シートがありますので、
私は「置換表」の存在を前提としたコードをアップしました。
あくまで質問者さんの質問に答えているつもりでした。
もし、そう言う話はもう終わっている、ということでしたら失礼しました。捨ててください。
 
私も、少し明解さに欠ける点があるなとは思っています。
>変換表に存在しない場合は、「_」に置き換え
というのが分からない。
通常の文字をことごとく「_」に置換するわけはないだろうから、
何かおかしい文字の集合というレベルのものがあるんでしょうね。
そこには含まれるのだが、置換表にはない、そういう言うときに「_」に置換するんでしょうね。
じゃあ、その「おかしい文字の集合」って誰が、何に基づいて判断しているのか。
 
なお、私のコードは、質問の最初の話であれば、対応できているものと思いますが、
もし置換を要するものが、1セルに1文字と決まっているなら、
置換表にヒットして処理したらすぐにExit Forするようにすれば良かったですね。
所要時間が平均して1/2になりますから。

投稿日時: 20/11/30 19:44:58
投稿者: kawata

多くの上級者様に回答をいただいて感謝することしきり、
質問者(私)自身がついていけていないので悶々としています。
 
ここにきてフローの見直しが必要か?と思い出しています、決して
後出し、条件変更の意図ではないことご理解願います。
 
入力された氏名(住所には環境依存文字が存在しない前提です、例外は
あります:「薭」(くさかんむりの「稗」)etc)に、
 
1.環境依存文字があるかないかをチェック
2.環境依存文字がある場合
 環境依存文字が「置換表」にあるかないかをチェック
 A.環境依存文字が「置換表」にある→対応する文字(第一水準、第二水準)
  に置換
 B.環境依存文字が「置換表」にない→「_」に置換
です。
 
ここで、第一水準、第二水準以外の漢字は「_」にするというルールで、
ただし置換表に有る環境依存文字は第一水準、第二水準に置換するという
ことです。
※環境依存文字は、IMEで変換する際に右に「環境依存文字」と表示される文字です。

回答
投稿日時: 20/11/30 20:57:23
投稿者: WinArrow
投稿者のウェブサイトに移動

ずいぶん条件が変わってしまいましたね・・・
 
環境依存文字を判定
を開設しているページがあるので
じっくり読んで、理解しましょう。

https://excel-ubara.com/excelvba4/EXCEL_VBA_403.html

回答
投稿日時: 20/11/30 21:30:14
投稿者: WinArrow
投稿者のウェブサイトに移動

↑で紹介した
関数とVBAの検証結果
 
例として
「辻」(一点しんにょう):LEN関数では3
CODE関数は、先頭の1桁のみ認識しているので63いはならない。
E列の関数は、環境依存文字
VBA:環境依存文字

回答
投稿日時: 20/11/30 21:37:20
投稿者: simple

置換表を使うというその時の前提に沿ってコードを提示したが、
何のコメントもなく、literallyに無視するのか。失礼な人だな。
私はここまでとします。

回答
投稿日時: 20/12/01 09:22:25
投稿者: WinArrow
投稿者のウェブサイトに移動

今回、目指している処理がよくわからなくなってきましたので、
振り出しに戻るようで、申し訳ありませんが、
目的を説明いただけますか?
 
世の中の動いは、
Unicodeで
今迄できなかったことができるようになった
ですね?
それを、できなかった時代の文字に変換するのが目的なのか?
 
「環境依存文字」が、「?」になることを避けたい
でしょうか?
それならば、変換する必要はありませんよね?
 
文字データの中には、「環境依存文字」を判別するデータは持っていないので
代用(みなし)で判別することになります。
↑で紹介したページは、ASC関数の戻り値が(63)で判定しています。
 
VBAの¥では、「文字」ではなく「桁」を取り扱います。
(「文字」:見た目1文字、「桁」:文字コード)
1文字が1桁、1文字が2ケタ、1文字が3桁というパターンがあります。
1文字が2ケタ、1文字が3桁は、無条件で「環境依存文字」と判定してもよいと思います。
しかし、1つのセルに、3つのパターンの文字が入っている
状態を前提にすると、1文字毎に3つのパターンを判別する必要があります。
 
これを念頭において、頑張ってください。
 
 

回答
投稿日時: 20/12/01 13:54:11
投稿者: WinArrow
投稿者のウェブサイトに移動

参考コードを下記します。
 
1文字のパターン(異体字セレクタ文字、サロゲートペア文字、常用文字)チェックを中心に書いてあります。環境依存文字チェック、変換表処理は、ご自由に補ってください。
なお、異体字セレクタ文字は、変換表を使わない処理となっています。
 

Sub test()
Dim srcMOJI As String
Dim bMOJI, i As Long
Dim xMOJI As String

    srcMOJI = Range("A1").Value
    ReDim bMOJI(1 To Len(srcMOJI))
    For i = LBound(bMOJI) To UBound(bMOJI)
        bMOJI(i) = Mid(srcMOJI, i, 1)
    Next
    
    If UBound(bMOJI) = 3 Then
        If AscW(bMOJI(2)) = &HDB40 Then
            MsgBox "異体字セレクタ文字です。"
            xMOJI = bMOJI(1)
            MsgBox "変換後文字:" & xMOJI
        Else
            MsgBox "異体字セレクタ文字ではありません。"
        End If
    ElseIf UBound(bMOJI) = 2 Then
        If AscW(bMOJI(1)) >= &HD800 And AscW(bMOJI(1)) < &HD8FF Then
            MsgBox "セロゲートペア文字です。"
            If 環境依存文字チェック(cMOJI:=srcMOJI) Then
                xMOJI = ""
                If 変換表チェック(vMOJI:=srcMOJI, xMOJI:=xMOJI) Then
                    MsgBox "変換後文字:" & xMOJI
                Else
                    MsgBox "変換できませんでした"
                End If
            End If
        Else
            MsgBox "セロゲートペア文字ではありません。"
        End If
    Else
        If 環境依存文字チェック(cMOJI:=srcMOJI) Then
            xMOJI = ""
            If 変換表チェック(vMOJI:=srcMOJI, xMOJI:=xMOJI) Then
                MsgBox "変換後文字:" & xMOJI
            Else
                MsgBox "変換できませんでした"
            End If
        End If
    End If

End Sub

Function 環境依存文字チェック(ByVal cMOJI As String)
    環境依存文字チェック = True
End Function


Function 変換表チェック(ByVal vMOJI As String, ByRef xMOJI As String)
    変換表チェック = True
    xMOJI = Range("B3").Value '変換後文字
End Function

 
私も、これで最後のレスといたします。
 

投稿日時: 20/12/01 18:57:02
投稿者: kawata

スレタイトルとは関係ありません、このスレ閉めます。
まさか、こういう展開になるとは思っても見ませんでした。
 
WinArrowさん、MMYSさん、mattuwan44さん、誠にありがとうございました、
特にWinArrowさんには最後のコードのご報告までは成したかったのですが
どうにも腹立たしく、我慢のできない状況です。
 
何故、人格否定のコメントを向けられにゃならん?、
己の気にいらん状況となれば、荒さがしから理由を見つけて捨て台詞、
この方の常とう手段ですな、かつ、それでも「性格だから仕方がない」
で済ます?、金輪際かかわりたくない人種だ。
 
ま、このあと給湯室でネチネチと騒がれるのを想像するのは難しくない
、毎度のことです。
 
誠に心苦しいですが閉めます。