Ｅｘｃｅｌで文字色別に文字数をカウントする方法は？

質問

ＥＸＣＥＬの表で、ある列に黒・青２色に分けて文字が入力されています。
列の中には一つのセルに黒・青の文字が混在している場合もあります。
知人が翻訳の仕事をやっていて、黒文字の分だけが報酬の対象になる関係で、色別に文字数をカウントする必要があります。
この作業をワークシート関数や何かのコマンドで実行する方法があるでしょうか。
もしなければＶＢＡで、ということになるかと思いますが、何分マクロが不得手なので、なかなか構文を考えつきません。どなたか教えて頂ければ助かります。よろしくお願いします。
なお、ＥＸＣＥＬで難しければＷＯＲＤの表に変換しても構いません。（行数は数千行あります。）

回答No.2

merlionXX · ベストアンサー

一つ一つのセル内に色が混在するのですね？それなら文字を一個ずつみていかねば。
それから、黒とはわざわざ黒を着色したのではなく「自動」でなっている黒でいいですね？

ある列がA列なら、B列に総文字数、C列に「自動」色の文字数、D列に青色の文字数を出します。

Sub test01()
Dim x As Long, i As Long
Dim n As Integer, black As Integer, blue As Integer
Dim c As Object

With ActiveSheet
x = .Cells(Rows.Count, "A").End(xlUp).Row
For i = 1 To x
If Trim(.Cells(i, "A")) <> "" Then
.Cells(i, "B") = Len(.Cells(i, "A"))
For n = 1 To Len(.Cells(i, "A"))
Set c = .Cells(i, "A").Characters(Start:=n, Length:=1)
If c.Font.ColorIndex = xlAutomatic Then black = black + 1
If c.Font.ColorIndex = 5 Then blue = blue + 1
Set c = Nothing
Next n
.Cells(i, "C") = black
.Cells(i, "D") = blue
black = 0
blue = 0
End If
Next i
.Range(.Cells(x + 1, "B"), .Cells(x + 1, "D")).FormulaR1C1 = "=SUM(R[-" & x & "]C:R[-1]C)"
End With
End Sub

お礼

ありがとうございました。
おかげさまで何とか出来ました。
ただ、その後マクロによらない別の方法があることも分かりましたので、今後状況によって使い分けたいと思っています。
参考までにその方法を記しますと、まずEXCELの該当列を複製してWORDにペーストし、全選択→編集→検索→置換→オプション→書式→フォント→ＯＫとし、文字色を選択の上、全置換で色付き文字を削除します。その上で表をEXCELの複製列に戻し、それぞれの文字数をLEN関数で計算するやり方です。
EXCELだけでもこのような操作はできますが、一つのセルに混在している場合、何故か選択した文字色以外の（自動の）文字も削除されてしまいます。（WORDだとうまく行きます。）
ともあれマクロの勉強になり、大変有益でした。厚くお礼申し上げます。

回答No.4

okormazd

#3です。
あっ!
試したのを直してないところがありましたので、訂正。
For i = 1 To l - 10
は
For i = 1 To l
です。

お礼

ありがとうございました。
おかげさまで何とか出来ました。
ただ、その後マクロによらない別の方法があることも分かりましたので、今後状況によって使い分けたいと思っています。
その方法は＃２の形へのお礼に記していますので、参考まで。
ともあれ不得手なマクロの勉強になり、ためになりました。
お礼申し上げます。

回答No.3

okormazd

色文字数を数える

Sub test()

Dim wb As Object, sh1 As Object
Dim myrange As Range

Set wb = Workbooks(ThisWorkbook.Name)
Set sh1 = wb.Sheets(1)

cl = 5 '明示的に指定したものだけ　1黒、2白、3赤、4緑、5青、6黄、7紫、8水色、等。自動はxlAutomatic。現在のカラー パレットによって変わるかも。
'自動が黒なら1ではとれない。xlAutomaticとして黒または自動にするか。

Select Case cl
Case 1
jcl = "黒"
Case 2
jcl = "白"
Case 3
jcl = "赤"
Case 4
jcl = "緑"
Case 5
jcl = "青"
Case 6
jcl = "黄"
Case 7
jcl = "紫"
Case 8
jcl = "水"
Case xlAutomatic
jcl = "黒または自動"
Case Else
jcl = "その他"
End Select

With sh1

Set myrange = .Range(.Cells(1, 1), .Cells(100, 20)) '検索範囲を指定します。

strn = 0
For Each c In myrange

l = Len(c)
For i = 1 To l - 10
If c.Characters(i, 1).Font.ColorIndex = cl Then
strn = strn + 1
End If
Next

Next

MsgBox jcl & "色文字数は" & strn & "です。"

End With

Set wb = Nothing
Set sh1 = Nothing

End Sub

回答No.1

kenta1984

参考になりそうなページがありましたのでご紹介します。
文章での説明は少々難しいので、参考URLをご覧ください＾＾；

参考URL：

http://blog.oni100.jp/?eid=305066

お礼

私の質問は文字色、しかも同一セル混在なので、参考URLの内容とは若干違いますが、何かのときに参考になるかも知れません。
ありがとうございました。