Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

16517 / 76734

←次へ　｜　前へ→


	【65682】セル内の一部のフォント色を変える

かな - 10/6/22(火) 12:53 -


	引用なし

	パスワード

セル内の一部のフォント色を変えたいのですが、うまくいかなくて悪戦苦闘しております。
どこが、いけないのか、アドバイスをいただけるとありがたいです

[ｼｰﾄ1]
PartNo　　1st　　　2nd　　　3rd　　　4th　　　5th　　　6th　　　7th ....まだ続きます（省略）
123-456　 AAAAAA　 BBBBBB　　　　　　DDDDDD　 EEEEEE　 FFFFFF
789-100　　　　　　RRRRRR　 WWWWWW　　　　　　TTTTTT

以下、700件ほどデータあります
セル内の値はすべて6文字です

例えば、2行目のBBBBBBとFFFFFFが青色のフォントになっています

[ｼｰﾄ2]には下記のように処理したいのです

同じセル内に5行値が順番に入っていき、下記のようにフォント色を指定したい
123-456　　AAAAAA　←黒
　　　　　 BBBBBB　←青
　　　　　 DDDDDD　←黒
　　　　　 EEEEEE　←黒
　　　　　 FFFFFF　←青　

しかし、現在のコードを作動させると、
123-456　 AAAAAA　←黒
　　　　　BBBBBB　←青
と始めはなるのですが、次に3つめの値を入れると、2つ目に入れた値が黒になってしまいます
123-456　 AAAAAA　←黒
　　　　　BBBBBB　←黒
　　　　　DDDDDD　←黒

最終的に、5つの値を同じセル内に入ったときの結果は、
123-456　　AAAAAA　←黒
　　　　　 BBBBBB　←黒
　　　　　 DDDDDD　←黒
　　　　　 EEEEEE　←黒
　　　　　 FFFFFF　←青

と、最後だけ青になって、2つ目の値は黒になったままです　

どうしても、分からなくて困ってます
どうか、お願いします

Sub test()

Dim MaxC As Variant
Dim My行 As Integer
Dim MyCell As Range

'最終列の取得
With Sheets(1).UsedRange
　　 MaxC = .Columns(.Columns.Count).Column
　　 MaxC = Left(Columns(MaxC).Address(False, False), InStr(Columns(MaxC).Address(False, False), ":") - 1)
End With

For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
　　　MyItem = Range("A" & i).Value
　 With Sheets(2)
　　　　 My行 = .Range("A" & Rows.Count).End(xlUp).Offset(1).Row
　　　　 .Cells(My行, 1).Value = MyItem
　　　'B列から最終列までチェックする
　　　For Each MyCell In Range("B" & i & ":" & MaxC & i)
　　　　　If MyCell.Value <> "" Then
　　　　　　 If MyCell.Font.ColorIndex = 5 Then '←フォント色が青だったら
　　　　　　　　If .Cells(My行, 2).Value = "" Then
　　　　　　　　　 .Cells(My行, 2).Value = MyCell.Value
　　　　　　　　　 .Cells(My行, 2).Font.ColorIndex = 5
　　　　　　　　　 .Cells(My行, 2).Font.Bold = True
　　　　　　　　Else　'指定セルに値が入っていたら下記処理する（最後の6文字を青にする）
　　　　　　　　　 .Cells(My行, 2).Value = .Cells(My行, 2).Value & Chr(10) & Chr(13) & MyCell.Value
　　　　　　　　　　MyLen = Len(.Cells(My行, 2).Value)
　　　　　　　　　 With .Cells(My行, 2).Characters(Start:=MyLen - 5, Length:=6).Font
　　　　　　　　　　　　　　　　　　　　　 .ColorIndex = 5
　　　　　　　　　　　　　　　　　　　　　 .Bold = True
　　　　　　　　　 End With
　　　　　　　　End If
　　　　　　Else　'フォント色が黒だったら
　　　　　　　　If .Cells(My行, 2).Value = "" Then
　　　　　　　　　 .Cells(My行, 2).Value = MyCell.Value
　　　　　　　　　 .Cells(My行, 2).Font.ColorIndex = 1
　　　　　　　　Else
　　　　　　　　　　.Cells(My行, 2).Value = .Cells(My行, 2).Value & Chr(10) & Chr(13) & MyCell.Value
　　　　　　　　　　 MyLen = Len(.Cells(My行, 2).Value)
　　　　　　　　　　 With .Cells(My行, 2).Characters(Start:=MyLen - 5, Length:=6).Font
　　　　　　　　　　　　　　　　　　　　　 .ColorIndex = 1
　　　　　　　　　　　　　　　　　　　　　 .Bold = False
　　　　　　　　　　 End With
　　　　　　　　End If
　　　　　　End If
　　　　 End If
　　　Next
　 End With
'　 End If
Next i

Sheets(2).Select

End Sub

3 hits

▼

【65682】セル内の一部のフォント色を変える かな 10/6/22(火) 12:53

≪