Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Pro : Microsoft 365)
指定範囲内の文字の色変えに関して
投稿日時: 23/12/06 08:31:00
投稿者: ta__ma

指定した範囲内のセル内の文字列に対して、下記条件で処理をしようとしています。
 赤文字があったら、青文字に変換
 青文字があったら、黒文字に変換
 
コードとしては、下記になります。(前後を省略します)
 
'指定範囲の各セルをチェック
 For Each cell In Selection
 
 'セル内の各文字をチェック
 For i = 1 To Len(cell.Value)
  '文字の色が青なら黒に、赤なら青に変更
  Select Case cell.Characters(i, 1).Font.Color
   Case RGB(0, 0, 255) ' 青
    cell.Characters(i, 1).Font.Color = RGB(0, 0, 0) ' 黒
   Case RGB(255, 0, 0) ' 赤
    cell.Characters(i, 1).Font.Color = RGB(0, 0, 255) ' 青
  End Select
 Next i
 
 Next cell

 
これを走らせると、稀に同一セル内に2色あると(例えば黒と赤とか)マクロはエラーなく終了しますが、同じマクロで保存したファイルを開こうとすると
○○○.xlsxの一部の内容に問題が見つかりました。可能な限り内容を回復しますか? ブックの発行元が信頼できる場合は「はい」をクリックしてください。
と表示されます。
 
セル内の文字列が長い方がエラーになる確率が高い気がしますが、長くて2色でも全く問題がないときもあります。
 
上記に関して、マクロで回避できる術はありますでしょうか。
 
ちなみに、選択範囲のフォントの統一は行っております。

回答
投稿日時: 23/12/06 12:57:44
投稿者: O.M

文字の色変えに関して私も教えていただいている最中だったため気になってスレッドを開いたのですが、
stepをマイナスで実行、Lenを.Characters.Countへかえてみてはどうでしょうか?
 
試しにコードをかいてみたのですが、私の環境ですとエラーは出なかったです。
 

Sub test()
Dim cell As Range
Dim i As Long, j As Long

'指定範囲の各セルをチェック
 For Each cell In Selection
  
  With cell
      j = .Characters.Count
     'セル内の各文字をチェック
     For i = j To 1 Step -1
      '文字の色が青なら黒に、赤なら青に変更
      With .Characters(i, 1)
        Select Case .Font.Color
         Case RGB(0, 0, 255) ' 青
          .Font.Color = RGB(0, 0, 0) ' 黒
         Case RGB(255, 0, 0) ' 赤
          .Font.Color = RGB(0, 0, 255) ' 青
        End Select
      End With
     Next i
  End With
 Next cell

End Sub

 
 
詳細は検証していないのですが、
 
 For Each cell In Selection
 
 'セル内の各文字をチェック
 For i = 1 To Len(cell.Value) 
'For i = Cell.Characters.Count to 1 step -1 に変更

  '文字の色が青なら黒に、赤なら青に変更
  Select Case cell.Characters(i, 1).Font.Color
   Case RGB(0, 0, 255) ' 青
    cell.Characters(i, 1).Font.Color = RGB(0, 0, 0) ' 黒
   Case RGB(255, 0, 0) ' 赤
    cell.Characters(i, 1).Font.Color = RGB(0, 0, 255) ' 青
  End Select
 Next i
 
 Next cell

回答
投稿日時: 23/12/06 15:15:07
投稿者: O.M

私もエラーとなるデータを見つけました、失礼致しました。
同じ文字を変換しても変換結果が変わってきてよく確認できてないです。
  
環境によっては再現ができないかもしれませんが、
参考までに記載します。
  
自動給排水機能付 RHE708R(別売:湯ポ
  
上記文字の「自動給排水機能付」、「8」、「(別売:湯ポ」の文字を赤色にしたもので試しました。
フォントは游ゴシック、サイズは11、セルの書式は標準、セル結合およびセル内改行は行っておらず、
エクセルのファイル形式はxlsmファイルで試しました。
  
パターン1
後ろに変換対象文字がついて長い文字になる
ただし、見た目が長いだけでセルを選択すると長い文字にはなっておらず、
セルをいじると元の長さに見える
※別の長文文字で試した際は、同じ症状の際に文字色は変わる場合もあれば変わらない場合もありました。
  
パターン2
最後尾に文字化け文字した文字がつく
  
パターン3
綺麗に変換できる
  
保存自体ができなくなるor開いたときにエラーとなります。
  
  
試したコード
  

Sub test()
Dim cell As Range
Dim i As Long, j As Long

Application.ScreenUpdating = False
Application.EnableEvents = False

'指定範囲の各セルをチェック
 For Each cell In Selection
  
  With cell
      j = .Characters.Count
     'セル内の各文字をチェック
     For i = j To 1 Step -1
      '文字の色が青なら黒に、赤なら青に変更
      With .Characters(i, 1).Font
        Select Case .Color
         Case RGB(0, 0, 255) ' 青
          .Color = RGB(0, 0, 0) ' 黒
         Case RGB(255, 0, 0) ' 赤
          .Color = RGB(0, 0, 255) ' 青
        End Select
      End With
     Next i
  End With
 Next cell

回答
投稿日時: 23/12/06 16:28:53
投稿者: WinArrow

最初の色を設定する時に、
複数文字を選択している、
1文字づつ選択している
の違いに関係するのではないでしょうか?

回答
投稿日時: 23/12/06 18:43:41
投稿者: Suzu

引用:
最初の色を設定する時に、
複数文字を選択している、
1文字づつ選択している
の違いに関係するのではないでしょうか?

 
セル内の文字列を選択した状態でマクロを実行している事を懸念していらっしゃるのでしょうか?
 
それは、通常の方法では、セル内の文字列を選択した段階でマクロが実行できなくなりますし
cell を Rangeとして宣言していますから、大丈夫かと。
 
 
さて、本題ですが 本音で言うと、原因は当方には判りかねます。
O.M さんが提示くださった様に、
.Characters.Count の方が良いとは思いますが、
 
それで、本当に解決するかは 判りません。
 
と言うのも、
「文字列の長さ」が関わる操作のとき、機種依存文字や、サロゲートペア 文字が 対象にあると
意図しない動作になる事があり得ます。
 
例えば
「ほっけ」の 漢字 魚へん に、花
「よしだ」の よし の 下が棒が長い よし
を続けて 入力し、ほっけ だけ フォント色を 赤として、
先のコードを実行してみてください。
 
画面表示上、ほっけ が消えませんか?
(数式バーには残っています)
 
こんなのもあります。
 
サロゲートペア文字を均等割り付けすると文字化けする。
https://answers.microsoft.com/ja-jp/msoffice/forum/all/%E3%82%B5%E3%83%AD%E3%82%B2%E3%83%BC%E3%83%88/eae7e85b-db28-415d-866d-098ff54ecfd8
 
 
バグと言いますか、意図しない様になる事があります。
今回の対象にも、サロゲートペア文字や、機種依存文字が含まれていませんか?
 
 
対処は・・判りかねます。
 
VBA上で、対処を探すのではなく、
対象の文字列がある場合、同じ行の別列に、その文字位置を表示させ、
その値を参考に、手動で 変更する様にした方が安定すると思います。

回答
投稿日時: 23/12/06 20:07:53
投稿者: O.M

私の説明不足で余計に混乱させてしまっている気がします、すみません。
 
 

引用:
自動給排水機能付 RHE708R(別売:湯ポ
     
上記文字の「自動給排水機能付」、「8」、「(別売:湯ポ」の文字を赤色にしたもので試しました。
フォントは游ゴシック、サイズは11、セルの書式は標準、セル結合およびセル内改行は行っておらず、
エクセルのファイル形式はxlsmファイルで試しました。
     
パターン1
後ろに変換対象文字がついて長い文字になる
ただし、見た目が長いだけでセルを選択すると長い文字にはなっておらず、
セルをいじると元の長さに見える
※別の長文文字で試した際は、同じ症状の際に文字色は変わる場合もあれば変わらない場合もありました。
     
パターン2
最後尾に文字化け文字した文字がつく
     
パターン3
綺麗に変換できる
     
保存自体ができなくなるor開いたときにエラーとなります。

 
ですが、「自動給排水機能付」、「8」、「(別売:湯ポ」をそれぞれ囲って3回にわけて赤色にしました。
   
説明が上手くできていなかったと思うのが
引用:
同じ文字を変換しても変換結果が変わってきて

の部分なのですが、
   
A1セルに文字を書いてエクセルを保存→マクロ実行をしてみる→Excelを保存せずに閉じる
を繰り返すと、それぞれのパターンが現れます。
   
変換後にExcelを保存せずに閉じているのでマクロを実行する際にはA1セルの文字情報は
全く同じはずなのですが、変換結果が記載した内容のように異なってきます。
   
※法則はわからずランダムのように感じます。
   
   
   
ステップ実行してウォッチウィンドウの確認はしたのですが、
   
引用:
For Each cell In Selection
   
  With cell

 
  
   
のwith cellで止めてウォッチウインドウで
 
cell.Characters
 
の+の部分を開いていって中身を見てみたのですが、その時点で色々な部分で
 
アプリケーションの定義またはオブジェクトの定義エラーです。
Rangeクラスの〜プロパティを取得できません。

 
などと表示されていてどこが関係しているのかつかめていません。
 
 
ためして失敗したコードと記載したものは、
途中で切れてしまっていたので張りなおしておきます。
   
Sub test()
Dim cell As Range
Dim i As Long, j As Long
 
Application.ScreenUpdating = False
Application.EnableEvents = False
 
'指定範囲の各セルをチェック
 For Each cell In Selection
   
  With cell
      j = .Characters.Count
     'セル内の各文字をチェック
     For i = j To 1 Step -1
      '文字の色が青なら黒に、赤なら青に変更
      With .Characters(i, 1).Font
        Select Case .Color
         Case RGB(0, 0, 255) ' 青
          .Color = RGB(0, 0, 0) ' 黒
         Case RGB(255, 0, 0) ' 赤
          .Color = RGB(0, 0, 255) ' 青
        End Select
      End With
     Next i
  End With
 Next cell
 
Application.ScreenUpdating = True
Application.EnableEvents = True
 
End Sub

回答
投稿日時: 23/12/06 22:30:51
投稿者: WinArrow

>セル内の文字列を選択した状態でマクロを実行している事を懸念していらっしゃるのでしょうか?
  
違います。
  

引用:
自動給排水機能付 RHE708R(別売:湯ポ

を題材で、
「自動給排水機能付」を赤
「8」を赤
「(別売:湯ポ」を赤
に競定して、テストしたら
「自」が青
「8」が青
「(別売:湯ポ」
に変更されました。
しかし、
「動給排水機能付」は、赤のままでした。
 
で、1文字づつ色を設定したら、全部OKでした。
  
 

回答
投稿日時: 23/12/07 12:35:52
投稿者: O.M

同じ色の文字はまとめて変換するようにした下記コードでエラーが出る確率は減りました。
※文字が後ろに増えて見える現象が1回起きたのですが、再現できず発生条件特定できていません。
 
※stepをマイナスで動かす場合のコードをうまく考えれなかったため前から変換にしています。
  

Sub test()
Dim cell As Range
Dim i As Long, j As Long, k As Long, st As Long
Dim flg As Boolean
 
Application.ScreenUpdating = False
Application.EnableEvents = False
 
'指定範囲の各セルをチェック
 For Each cell In Selection
   
  With cell
      j = .Characters.Count
     'セル内の各文字をの連続色をチェック
     
     
     For i = 1 To j
     
        With .Characters(i, 1).Font
            Select Case True
              Case i = 1
                st = 1
                k = 1
                If .Color <> cell.Characters(i + 1, 1).Font.Color Then flg = True
              Case i = j
                k = k + 1
                flg = True
              Case Else
                If .Color <> cell.Characters(i + 1, 1).Font.Color Then
                  flg = True
                  k = k + 1
                Else
                  k = k + 1
                End If
            End Select
        End With
            '文字の色が青なら黒に、赤なら青に変更
        If flg = True Then
          With .Characters(st, k).Font
             Select Case .Color
              Case RGB(0, 0, 255) ' 青
               .Color = RGB(0, 0, 0) ' 黒
              Case RGB(255, 0, 0) ' 赤
               .Color = RGB(0, 0, 255) ' 青
             End Select
           End With
           flg = False
           st = i + 1
           k = 0
         End If
     Next i
  End With
 Next cell
 
Application.ScreenUpdating = True
Application.EnableEvents = True
 
End Sub

回答
投稿日時: 23/12/07 22:16:28
投稿者: MMYS

Excelの内部文字コードは、Unicodeです。Unicodeは制定当時、1文字2バイトと決められました。しかし、その後、サロゲートペア導入で一部文字が4バイトに拡張。さらに異体字セレクタでは、7バイトだったりします。
 
Excel本体は、これに対応していますが(そのはず)、問題はExcel-VBAの内部処理はサロゲートペア非対応で1文字2バイトで処理だったと思います。つまり、VBAで1文字づつ処理すると、本来、文字コードが4バイトで処理すべきところをVBAは2バイトで処理してしまうので、内部文字コードにズレが生じて、内部文字コードが破損。そのままファイル保存すると、ファイル破損につながると思います。
大抵の文字は2バイトなので問題が発生する可能性は低いですが、特殊な文字を扱う環境なら、Charactersなどで一文字づつ処理するのはおすすめできません。
 
下記コードは、WORDの置き換え機能で、一括色変換してますから、理屈上、問題は起きないはずです。
 
■Microsoft Word xx.x Object Library に参照設定

Sub Test()
    Dim wd  As Word.Application
    Dim doc As Word.Document
    
    Set wd = New Word.Application
    wd.Visible = True
    Set doc = wd.Documents.Add

    Range("A1:A10").Copy
    wd.Selection.PasteExcelTable False, False, False
    Application.CutCopyMode = False

    With doc.Content.Find
        .ClearFormatting
        .Font.Color = &HFF '= RGB(255, 0, 0)
        .Format = True
        .Replacement.ClearFormatting
        .Replacement.Font.Color = &HFF0000  '= RGB(0, 0, 255)
        .Execute Forward:=True _
               , Replace:=WdReplace.wdReplaceAll _
               , FindText:="" _
               , ReplaceWith:=""
    End With

    doc.Tables(1).Range.Copy
    Range("C1").Select
    ActiveSheet.Paste

    wd.Quit Savechanges:=WdSaveOptions.wdDoNotSaveChanges
    Set doc = Nothing
    Set wd = Nothing
End Sub

 
ちなみに、Excel-VBAに限らずサロゲートペア非対応のアプリは結構あります。
特に、内部で一文字ごとに処理するようなプログラムは意図的にサロゲートペア等の処理が必要です。普通にコードを作成するとサロゲートペア非対応になってしまいます。
 

回答
投稿日時: 23/12/08 01:19:00
投稿者: O.M

MMYSさん
いろいろ理解できていなかった部分がわかりやすかったです、ありがとうございます。
 
ta__maさん
サロゲートペア文字や、4バイトを超えるマルチバイト文字を変換して
私の記載したCharactersのコードで不具合を確認しました、失礼しました。
 
 
不具合を確認した手順ですが、サロゲートペアで検索して見つけました下記サイトをもとに
𩸽、𠮟、🙇‍♂️、🙅‍♂️の文字を交えて私が書いたCharactersのコードを試しました。
https://excel-ubara.com/excel5/EXCEL886.html
 
1.色変換を行うと変換後に違う文字になる
𩸽、𠮟が変換後に文字が全角スペースに見える症状→セルをクリックすると治って見える
🙇‍♂️、🙅‍♂️が変換後に違う絵文字に見える症状→セルをクリックすると治って見える
 
※文章中に例示された文字が1文字の単品で色変換となっている場合に起きました
※上記の場合は、変換後に保存して再度開くことはできその際は元の文字にみえました
 
 
 
2.マクロ実行するとエクセルが強制終了
※いろいろな部分に文字を仕込んでいたので何が原因なのかは特定できませんでした。

投稿日時: 23/12/08 13:25:23
投稿者: ta__ma

皆様、いろいろコメントありがとうございます。
 
2バイト→4バイトコードの違いが自分のコードでも原因だと思いました。
修正案を再考してみます。

回答
投稿日時: 23/12/09 02:19:53
投稿者: O.M

私が書式を維持しての文字変換に関していろいろ質問させていただいております
https://www.moug.net/faq/viewtopic.php?t=82555
のスレッドで、こちらの件を話題にさせていただいたところ、
simpleさんからご回答いただました。
 
すごくすっきりしたコードで素早くきれいに変換できましたので、
ご報告させていただきます。

投稿日時: 23/12/11 08:34:27
投稿者: ta__ma

O.Mさん
ありがとうございます。
 
こちらもかなり勉強になりそうです。
これからじっくり読み解いていきます。

回答
投稿日時: 23/12/12 14:31:06
投稿者: simple

O.Mさんコメントありがとうございます。
改めて書くならこうですか。
セルのフォント色が単色の場合も含めて変更するとすればこうなると思います。
 

Sub test()    '選択セル範囲の文字色を、青を黒に、赤を青に変更
    Const colRed As String = "html:Color=""#FF0000"""    '赤
    Const colBlue As String = "html:Color=""#0000FF"""    '青
    Const colBlack As String = "html:Color=""#000000"""    '黒
    Dim c     As Range
    Dim s     As String
    Dim col   As Variant
    For Each c In Selection
        col = c.Font.Color
        If IsNull(col) Then         'フォント色が混在しているとき
                s = c.Value(xlRangeValueXMLSpreadsheet)
                s = Replace(s, colBlue, colBlack)       '青を黒に
                s = Replace(s, colRed, colBlue)         '赤を青に
                c.Value(xlRangeValueXMLSpreadsheet) = s
        ElseIf col = vbBlue Then
                c.Font.Color = vbBlack
        ElseIf col = vbRed Then
                c.Font.Color = vbBlue
        End If
    Next
End Sub

・セルが単色の場合は、XMLSpreadsheet形式ではうまくいきません。
   (Styleで調整するので、対応可能でしょうけど面倒になるように思います。)
・またすべてが混色と分かっていれば、セル範囲全体で一括して変換ができますが、
 そうでなければ、スピードは若干ロスになってもセル毎に判断するのがよいと思います。
# あちらのスレッドは長大になっているので、読むのは大変かもしれません。

トピックに返信