[[20200522154027]] 『VBA 同一セル内の色分け』(beginer) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『VBA 同一セル内の色分け』(beginer)

【条件】
条件付き書式で特定の文字列に色が付くようにしている範囲があります。

その範囲の1行5セルをFor文で読み取って条件付き書式の色情報とともに

1つのセルに改行して入力するようにしました。

そのソースを以下に記します。

【ソース】
Dim cell As Range
Dim read As Range
Set cell = Range("A1") '入力するセル
Set read = Range("A2") '読み取る行の第1セル

For i = 1 To 5

 If i = 1 Then

  cell.Value = read.Offset(0,i).Value

  cell.Font.color = read.(0,i).DisplayFormat.Font.color

 ElseIf 

  cell.Value = cell.Value & vbLf & read.Offset(0,i)

  cell.Characters(Len(cell)-Len(read.Offset(0,i))+1,Len(read.Offset(0,i))).Font.color
  = read.Offset(0,i).DisplayFormat.Font.color

 End If

Next

【問題点】
読み取るセルが2つ以下だと色分けされて入力されますが、
読み取るセルが3つ以上になるとすべて同じ色で入力されます。

色分けができるようにするにはどうすればよろしいでしょうか?
ご教授願います。

< 使用 Excel:Excel2016、使用 OS:Windows10 >


そもそも構文エラーですので、実際のコードと
違うのではないでしょうか。
(tkit) 2020/05/22(金) 16:37

 多分、Valueを都度入れ替える内に、Characters 情報が失われるんじゃないですかね。

 先に、最終的な合成文字を作ってValueに入れ、その後、色付けを順次実施すれば不安がないです。

(半平太) 2020/05/22(金) 17:55


失礼しました。
修正しました。
以下ソース全文です。

Private Sub Worksheet_Activate()

 Dim cell As Range 
 Dim read As Range 
 Set cell = Range("A1") '入力するセル 
 Set read = Range("A2") '読み取る行の第1セル 

 For i = 0 To 5 

  If i = 0 Then

   cell.Value = read.Offset(0,i).Value

   cell.Font.color = read.(0,i).DisplayFormat.Font.color

  Else

   cell.Value = cell.Value & vbLf & read.Offset(0,i)

   cell.Characters(Len(cell)-Len(read.Offset(0,i))+1,Len(read.Offset(0,i))).Font.color _
   = read.Offset(0,i).DisplayFormat.Font.color

  End If

 Next 

End Sub
(beginer) 2020/05/22(金) 18:05


半平太さん 

ありがとうございます。

試してみます。
(beginer) 2020/05/22(金) 18:06


【続報】
以下のようにしたらうまくいきました。
半平太さん重ね重ねありがとうございました。

【ソース】
Private Sub Worksheet_Activate()

 Dim cell As Range 
 Dim read As Range 
 Set cell = Range("A1") '入力するセル 
 Set read = Range("A2") '読み取る行の第1セル 

 Dim strlen As Integer

 For i = 0 To 5 

  If i = 0 Then

   cell.Value = read.Offset(0,i).Value

  Else

   cell.Value = cell.Value & vbLf & read.Offset(0,i)

  End If

 Next 

 strlen = 0

 For j = 0 To 5

  cell.Characters(strlen + 1,Len(read.Offset(0,j))).Font.color _
  = read.Offset(0,j).DisplayFormat.Font.color
  strlen = strlen + Len(read.Offset(0,j)) +1

 Next

End Sub

(beginer) 2020/05/22(金) 19:07


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.