Excel でマクロ利用しセル内テキストを修正しております（半角ｶﾅを全角にするなど）。 ただ、セル

Excel でマクロ利用しセル内テキストを修正しております（半角ｶﾅを全角にするなど）。

ただ、セル内のテキストカラーが着色されていた場合 色情報が維持されずすべて黒色になってしまう欠点があり現状 十分に効率化できておりません（全角カナにした後手動で色分けを復旧しなければならないためです）。

セル内でテキストが色分けされているとき 色分けを維持したままマクロの機能を利用するには どのような記述を加えればよいでしょうか。

詳しい方 何卒 よろしくお願い申し上げます。

No.4 回答者： fujillin 回答日時： 2023/06/17 15:15

No3です。

少し考え方を変えてみました。
No2では、意味の無い濁点・半濁点は勝手に削除してしまっていましたが、日本語として意味が無くてもそのまま全角の濁点・半濁点に変換するようにしてみました。

例えば、No2では
　「ﾏﾞﾐﾞﾑﾞﾒﾞﾓﾞ」 → 「マミムメモ」
　「ﾏﾟﾀﾞﾞﾞｶﾞｽｶﾙﾞ」 → 「マダガスカル」
となるようにしていましたが、これをそのまま（原文を尊重して）
　「ﾏﾞﾐﾞﾑﾞﾒﾞﾓﾞ」 → 「マ゛ミ゛ム゛メ゛モ゛」
　「ﾏﾟﾀﾞﾞﾞｶﾞｽｶﾙﾞ」 → 「マ゜ダ゛゛ガスカル゛」
となるように修正（？）してみました。

Sub KatakanaChanger2()
Dim R As Range, c As Range
Dim s As String, i As Long

Set R = Range("B2:B7") ' ←対象セル範囲

For Each c In R.Cells
i = c.Characters.Count
While i > 0
s = c.Characters(i, 1).Text
If "ｦ" <= s And s <= "ﾝ" Then
c.Characters(i, 1).Text = StrConv(s, vbWide)
ElseIf s = "ﾞ" Or s = "ﾟ" Then
s = StrConv(c.Characters(i - 1, 1).Text & s, vbWide)
If Len(s) = 1 Then
c.Characters(i, 1).Text = ""
i = i - 1
End If
c.Characters(i, 1).Text = Right(s, 1)
End If
i = i - 1
Wend
Next c
End Sub

No.3 回答者： fujillin 回答日時： 2023/06/16 11:39

こんにちは

セル内の文字は1文字ずつ色を変えることが可能なので、結局は、1文字ずつチェックするしかないと考えられます。

Cells(～).Caracters オブジェクトの .Count 属性で文字数を取得できますので、
　For i = 1 To .Characters.Count
　　Set c = .Characters(i, 1)
のようにしてループすれば1文字ずつの処理が可能です。

文字の色は c.Font.Color で取得できますが、直接文字を置き換えてしまえば色を気にする必要はなくなります。
　.Characters(i, 1).Font.Text = 置換える文字
とすることで、i 文字目のひと文字だけ文字を変更できます。
（文字色はそのままです）
ただし、半角カタカナの場合、濁点・半濁点はそれぞれ1文字ですが、全角の場合は半角2文字で全角1文字になるので、この部分だけは工夫して処理を行う必要がありそうです。


以下、指定セル範囲に対してカタカナの全角変換を行う簡単なものを作成してみましたので、ご参考までに。
（もう少し要領の良い方法がありそうな気がしますけれど・・）

※ 1文字に変換できない「ﾏﾞﾐﾞﾑﾞﾒﾞﾓﾞ」などは「マミムメモ」に変換されます。
　対応する全角文字が存在する「ｳﾞ」のような場合は「ヴ」になります。
　
Sub KatakanaChanger()
Dim r As Range, c As Range
Dim s As String, s1 As String
Dim i As Long

Set r = Range("A1:A5") ' ←対象セル範囲

For Each c In r.Cells
For i = 1 To c.Characters.Count
s = c.Characters(i, 1).Text
If "ｦ" <= s And s <= "ﾝ" Then
s1 = c.Characters(i + 1, 1).Text
If s1 = "ﾞ" Or s1 = "ﾟ" Then s = s & s1
c.Characters(i, 1).Text = Left(StrConv(s, vbWide), 1)
End If
Next i

For i = c.Characters.Count To 1 Step -1
s = c.Characters(i, 1).Text
If s = "ﾞ" Or s = "ﾟ" Then c.Characters(i, 1).Text = ""
Next i
Next c
End Sub

No.2 回答者： amerikaumare 回答日時： 2023/06/16 00:35

chatGPTに聞いてみたら　このように回答されました

Excel VBAを使用してセル内のテキストを修正する際に、セルのテキストの色を維持する方法は次のとおりです。

１．セル内のテキストの色情報を一時的に保存します。
２．テキストを修正します（半角カナを全角に変換など）。
３．修正したテキストをセルに戻します。
４．保存しておいた色情報をセルに適用します。
以下は、この手順を反映したVBAコードの例です。

vba
Copy code
Sub ModifyCellText()
Dim cell As Range
Dim originalColor As Long

' 選択したセルの範囲内でループ
For Each cell In Selection
' セルのテキストの色情報を保存
originalColor = cell.Font.Color

' テキストを修正（例: 半角カナを全角に変換）
cell.Value = StrConv(cell.Value, vbWide)

' 修正したテキストをセルに戻す
'（テキストの色情報は黒色になるが、後で復元するために一時的に変更）
cell.Font.Color = vbBlack

' セルに保存しておいた色情報を適用
cell.Font.Color = originalColor
Next cell
End Sub
このVBAマクロは、選択したセル範囲内のテキストを修正し、修正前のテキストの色を維持します。選択したセルの範囲を変更する場合は、Selectionを適切な範囲指定に変更してください。

注意点として、このマクロは半角カナを全角に変換するだけの例です。他の修正処理を追加する場合は、適宜修正してください。また、マクロを実行する前に作業内容のバックアップやテストを行うことをおすすめします。

No.1 回答者： Qchan1962 回答日時： 2023/06/15 22:27

こんばんは

確認事項を気が付き削除しました

取り敢えず　セル内のすべてのフォント色なら
対象はA１セル　出力先はA1かA2　（あくまで参考です）
Dim tmp As Double
tmp = Range("A1").Font.Color
Range("A2").Value = StrConv(Range("A1").Text, vbWide)
Range("A2").Font.Color = tmp
とか　.copyした後に変換とか　考えられますね
Range("A1").Copy Range("A2")
Range("A2").Value = StrConv(Range("A2").Text, vbWide)



＞セル内でテキストが色分けされているとき
読み飛ばしていました。。。

セル内の一部分のテキストの変換となると　1文字づつ取得設定するとか
半角カタカナをキーワードとして取得してから　ある程度纏めて行うとかになるのかな・・（一文字ごとに色が違うかもですので1文字づつ取得）

出力が違うセルの場合、
Dim i As Integer
With Range("A1")
Range("A2").Value = StrConv(.Text, vbWide)
For i = 1 To Len(.Text)
Range("A2").Characters(Start:=i, Length:=1).Font.Color _
= .Characters(Start:=i, Length:=1).Font.Color
Next
End With

同じセルなら　あらかじめ各文字の色を配列に一時保存して
Dim i As Integer
With Range("A1")
ReDim tmp(Len(.Text))
For i = 1 To Len(.Text)
tmp(i) = .Characters(Start:=i, Length:=1).Font.Color
Next
.Value = StrConv(.Text, vbWide)
For i = 1 To Len(.Text)
.Characters(Start:=i, Length:=1).Font.Color _
= tmp(i)
Next

範囲をループしたりして使うのだと思いますが
1文字づつ変換する場合、処理にはそれなりの時間を要すと思います

各例共に　カタカナのみ半角から全角にする場合はカタカナ判別の条件分が必要ですね（不明なところもありますが、既にあるようですので割愛しました。）