| |
セル内の一部のフォント色を変えたいのですが、うまくいかなくて悪戦苦闘しております。
どこが、いけないのか、アドバイスをいただけるとありがたいです
[ｼｰﾄ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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
