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

1 hits

【65682】セル内の一部のフォント色を変える かな 10/6/22(火) 12:53 質問
【65687】Re:セル内の一部のフォント色を変える Jaka 10/6/22(火) 14:49 発言
【65689】Re:セル内の一部のフォント色を変える かな 10/6/22(火) 15:04 質問
【65690】Re:セル内の一部のフォント色を変える Jaka 10/6/22(火) 15:09 発言
【65724】Re:セル内の一部のフォント色を変える まだ新人 10/6/24(木) 4:48 発言
【65725】Re:セル内の一部のフォント色を変える まだ新人 10/6/24(木) 5:02 発言

16517 / 76734 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free