• ベストアンサー

VBAで、セルの一部の文字色を変更するプログラムで困っています

ループ処理で、1つのセルに次のように1行ずつ追記するプログラムを作成しようとしています。 ■文字列1 ■文字列2 ■文字列3   : セル内で改行したいので、2行目以降はChr(10)でつないでいます。 「文字列」の箇所は黒字でいいのですが、「文字列」の内容によって、「■」の文字色を5色で色分けしたいです。 色は「文字列」の内容によって決まるので、あるときは、1行目の「■」は緑、2行目の「■」はピンク、…であっても、 またあるときは、1行目の「■」はピンク、2行目の「■」は青、…というように、可変です。 そこで、次のようなソースを書いたのですが、うまくいきません。  For i = 1 to 10   out_str = "■" & mojiretsu(i)   Cells(i, j).Select   outchar_start = Len(ActiveCell.Value)   If outchar_start = 0 Then     ActiveCell.Value = out_str   Else     ActiveCell.Value = ActiveCell.Value + Chr(10) + out_str   End If   ActiveCell.Characters(Start:=outchar_start + 1, Length:=1).Font.color _     = RGB(ReturnColor(mojiretsu(i), RR), _        ReturnColor(mojiretsu(i), GG), _        ReturnColor(mojiretsu(i), BB))   ActiveCell.Characters(Start:=outchar_start + 2).Font.color = RGB(0, 0, 0)  Next   ※ ReturnColor関数は、文字列の内容に応じて、RGBのコードを返す自作の関数です。 1回目のループ終了後は、「■」のみ色がつき、「文字列」は黒字という状態なのですが、 2回目以降のループが実行されると、セルのすべての文字に色が付いてしまいます。 (ActiveCell.Value = ActiveCell.Value + Chr(10) + out_str で上書きしているので、その時点で文字のプロパティが無効になってしまうのでしょうか??) ちなみに、上のソースでは、説明の便宜上、For文で10回ループさせていますが、 実際はテキストファイルを読込み、そのファイルの行数によって、1セルに書きだす行数が決まりますので、 何行出力させるかは、固定ではありません。 また、追記させるセルも1セルだけではなく、50セルくらいあるうちのどのセルに追記するかをその他の条件により判定しています。 セルの何文字目を何色にするかという情報を別に記憶しておいて、 最後に文字のプロパティを変更させることも考えたのですが、 上記のことを考慮すると、あまりスマートなやり方ではないのかなと思いました。 不慣れなためプロパティの考え方が間違っているだけかもしれませんが、 何かいい方法がありましたら、ご教示お願いします。

質問者が選んだベストアンサー

  • ベストアンサー
  • Wendy02
  • ベストアンサー率57% (3570/6232)
回答No.2

こんばんは。 何か、質問内容と、コードが一致していないように思うのですが、何か不足しているのでしょうか? たぶん、アイデア倒れの気がします。本来は、二つの要件をひとつにまとめてしまったことが問題を作ってしまっているのだと思います。もちろん、複雑にすれば可能だと思いますが、回答者側では、文字列が、どのようにして加えていくかは、分からないし、すべてのコードとデータが明かされない限りは良く理解できません。それと、Excel のVersion にもよりますが、ColorIndex で色を加えればよいと思います。 そこで、 ActiveCell.Value = ActiveCell.Value + Chr(10) + out_str これに文字列(mojiretsu)を加えていくということは、それは、そのままにしておいて、文字に色を加えることは別けて、最後にしたほうがよいですね。スマートかどうかは別として、Fontの一文字に色をつけたとしても、文字列を加えれば、そこで、書式は更新されてしまいます。 このサブルーチンの意味は分かると思いますから、細かくは説明しません。 '------------------------------------------- Sub ChangeFontColor(ByVal rng As Range) Dim i As Long Dim j As Long Dim ar As Variant ar = Array(3, 5, 7, 8, 10) '赤,青,ピンク,水色, 緑 For i = 1 To Len(rng.Value)  With rng.Characters(i, 1)   If .Text = "■" Then    .Font.ColorIndex = ar(j)    j = j + 1   End If  End With Next i End Sub

yuri_tti
質問者

お礼

Wendy02様、アドバイスを頂きましてありがとうございます。 急な出張が入り、回答が遅くなってしまいました。申し訳ございません。 また、質問がわかりづらくてすみません。 コードが明かせないわけではなかったのですが、質問の要点を示そうと思い、簡易なプログラムに変更して掲載しました。かえって分かりづらくなってしまい、お手間をお掛けしました。 > スマートかどうかは別として、Fontの一文字に色をつけたとしても、文字列を加えれば、そこで、書式は更新されてしまいます。 文字列を追記した時点で、設定済みの書式は更新してしまうのですね。 設定済みの箇所の書式を残しつつ、追記する方法がもしあったらと思い質問させて頂きました。 Wendy02様に書いて頂いた、サブルーチンを参考にして、最後に書式を設定するプログラムにしたところ、目的を果たすことができました。 本当にありがとうございました。

その他の回答 (1)

  • rukuku
  • ベストアンサー率42% (401/933)
回答No.1

こんばんは >「文字列」の箇所は黒字でいいのですが、「文字列」の内容によって、 >「■」の文字色を5色で色分けしたいです。 「■」と「文字列」の列を分ければ解決するように思えます。 公開できないような固有名詞は○○や△△に置き換えても構いませんので、もう少し「どのようなことをやりたいのか」を教えてください。

yuri_tti
質問者

お礼

rukuku様、早速のアドバイスを頂きましてありがとうございます。 急な出張が入り、回答が遅くなりました。お詫び申し上げます。 コードが明かせないということはまったくなかったのですが、質問の要点を示そうと思い、簡易なプログラムに変更して掲載しました。 かえって分かりづらくなってしまい、申し訳ございません。 できあがりのフォーマットは変更することはできず、「■」と「文字列」は同じセルで、しかも複数行を1セルに出力する必要があるのです。 設定済みの箇所の書式を残しつつ、追記する方法がもしあったらと思い質問させて頂いたのですが、そのような方法はなかったようです。 書式を設定しながら追記する方法は諦め、すべての追記が終了後に、書式を設定するプログラムにしたところ、目的を果たすことができました。 本当にありがとうございました。

関連するQ&A

  • VBAのプログラムでうまく動かなくて困っています。

    VBA初心者です。 エクセルのVBAのプログラムでうまく動かなくて困っています。教えていただける方がいらしたら、ぜひ教えて下さい!よろしくお願いします。エクセルの内容は以下のとおりです。 (内容) セル    E H J L N P R・・・ 8行目100 200 50 40 30 80 9行目130 350 10 50 60 120 110 ・ ・ (1)列Hの値が列Eの値より大きい場合その下に行を追加します。 (2)セルJ+セルL+セルN+・・をしてセルEの値を超えたセル以降の値を追加した行のセルJ列から順にコピペする処理です。 上のセルの1行目の内容でいいますと、 (1)列Hの値「200」が列Eの値「100」より大きいのでその下に行追加 (2)セルJ、L、N「50」+「40」+「30」でセルEの値「100」より大きいので、追加した行のセルJ列にセルN、Pの値をコピペするです。 以下が私が書いたプログラムです。 Sub test() Dim x As Integer Dim s As Integer Dim t As Integer x = Range("B8").End(xlDown).Row r = Range("J8").End(xlToRight).Column '8行目から最終行までループ For i = x To 9 Step -1 If Cells(i, 5) < Cells(i, 8) Then ☆【For r = y To 11 Step -2 Cells(s, t).Value = Cells(i, r) + Cells(i, r + 2) If Cells(i, 5).Value < Cells(s, t).Value            Then Exit For Next】 Rows(i + 1).Insert Shift:=xlDown '超えたセルをコピーして、1行下の"J列以降"に代入 ★ x = x + 1 End If Next i End Sub 上記プログラムで★の部分がうまく書けません。☆の部分も間違っているような気がします。よろしくお願いします。

  • VBA withの使い方

    VBAの参考書で勉強をしていますが、withの使い方で引っかかっているので、どなたかご教授ください。Excel2002 よくある見積書の表で、横方向の掛け算を行方向下に連続して行おうとしています。 C列-数量 D列-単価  E列に、C列の数量×D列の単価 をVBAで行の先頭から下方向に順番に計算する。 その際に、C列の数量のセルが空白だったら何もせず終了という下記のループの方法が 参考書に書いてあります。(セルE14がE列の計算する最初のセル) Range("e14").Select Do Until ActiveCell.Offset(0, -2).Value = "" With ActiveCell .Value = .Offset(0, -2).Value * .Offset(0, -1).Value .Offset(1, 0).Select End With Loop 上記のwithの位置をDo~Loopの外に出して以下のように書き換えたら、 Range("e14").Select With ActiveCell Do Until .Offset(0, -2).Value = "" .Value = .Offset(0, -2).Value * .Offset(0, -1).Value .Offset(1, 0).Select Loop End With 最初のセルE14は正しく計算処理をするが、1つしたのセルにアクティブセルが移動した後、永久ループに入ってしまいます。 「デバック」ボタンをクリックすると[.Offset(1, 0).Select]の行が黄色くなっているのですが、どこに問題があるのかが分からない状態です。 お手数ですが、よろしくお願いします。

  • VBAプログラムについて

    VBAプログラムを本を見ながら作成していますが、はっきりいって素人です。 本に載っていないこととなるとちんぷんかんぷんで、いくつかあるプロシージャのどのプロシージャ内に記入したら良いのか分からないし、新しいプロシージャをどこに記入して良いのか分かりません。 例えば、 ----------------------------------------------------------- Private Sub CommandButton1_Click() ActiveCell.Value = TextBox1.Value ActiveCell.Offset(0, 1).Value = TextBox2.Value ActiveCell.Offset(0, 2).Value = TextBox3.Value ActiveCell.Offset(0, 3).Value = TextBox4.Value ActiveCell.Offset(0, 4).Value = TextBox5.Value ActiveCell.Offset(0, 5).Value = TextBox6.Value ActiveCell.Offset(0, 6).Value = TextBox7.Value ActiveCell.Offset(0, 7).Value = TextBox8.Value ActiveCell.Offset(0, 8).Value = TextBox9.Value ActiveCell.Offset(1, 0).Activate End Sub Private Sub CommandButton2_Click() Unload Me End Sub Private Sub Label1_Click() End Sub Private Sub UserForm_Click() End Sub Private Sub UserForm_Initialize() Range("A2").Activate End Sub ---------------------------------------------------------- テキスト入力フォームをいくつか作っており、コマンドボタン1とコマンドボタン2で入力ボタンと閉じるボタンにしています。   このプログラムでは、入力ボタンをクリックすることでデータが入力されて、入力された列のすぐ次の列の最初のセルがアクティブな状態になります。 (1)データ入力済みのエクセルシートにおいて、アクティブな状態にしたセルや列を削除したい場合、どこにどのように書けば良いのでしょうか? (2)データ入力が一度に終わらない時、途中の任意の列から入力を始めたい場合はどこにどのように書けば良いのでしょうか? 本に書かれていることは丸写しできますが、ちょっとでも違うと壁にぶつかってしまいます。 独学で勉強する時に良いと思われる方法はどんな方法なのでしょうか? おこがましいですが素人も分かりやすい説明をして頂けると助かります。 宜しくお願いします。

  • VBA セル内改行+他セルの文字をカット&ペースト

    A1セル内文字の最後部分にカーソルを持っていって、Alt+Enterを押してA1セルを2行に改行する、 B1にある値をカットして、A1の改行した部分に貼り付け というマクロを作るべく、「マクロの記録」をしてみたところ、A1のテキストがそのままマクロに書き込まれてしまって応用ができないです。 改行部分に貼り付けするにはB1セルの値はコピーではなくカットが必要だと思いますが、これも「マクロの記録」だと動作ではなくテキストそのものが書き込まれてしまい、応用が効きません。 Sub A1改行カットペースト() ' ' A1改行カットペースト Macro ' ' ActiveCell.FormulaR1C1 = "RO20-001" & Chr(10) & "" Range("B1").Select ActiveCell.FormulaR1C1 = "" Range("A1").Select ActiveCell.FormulaR1C1 = "RO20-001" & Chr(10) & "8/7到着" Range("F4").Select End Sub "RO20-001"と"8/7到着"はA1とB1の値であって、この記述ではこのマクロをループさせた時、他の全部のセルに"RO20-001"と"8/7到着"が貼りついてしまいます。 改行やテキストのカット&ペーストの「動作」はどのように記述すれば良いのでしょうか? どなたかご存じの方がいらっしゃいましたら、教えて下さい。 よろしくお願いします。

  • Excel VBA セル選択

    Sub 全角() Dim i As Long, buf As String For i = 1 To Len(ActiveCell.Value) If Mid(ActiveCell.Value, i, 1) Like "[ア-ン]" Then buf = buf & StrConv(Mid(ActiveCell.Value, i, 1), vbWide) Else buf = buf & Mid(ActiveCell.Value, i, 1) End If Next i ActiveCell.Value = buf End Sub このコードだと一つのセルしか変換できません。 選択した範囲全部を変換できるようにしたいです。

  • Excel VBA で 一括書式設定(セル内の一部のみ)

    こんにちは。教えてください。 1つのセル内に、 あいうえお1か き! くけこ2 さしすせそ3たち。 つてと45.67? というように、いくつかのセル内改行を含み、文字数がばらばらのデータが入っています。そういうセルが、一行にいくつも並んでいます(途中に空白もあります)。 それらの1行目(上記の例で言うと、「あいうえお1か」)のみ、フォント赤色の書式設定を、マクロで行いたいのです。 そこで、以下のマクロを実行すると、選択セルがひとつだけのときは問題ないのですが、複数のセルを選択すると実行時エラー(型が一致しません)が出てしまいます。 Sub 一行目赤() With Selection.Characters(Start:=1, Length:=InStr(Selection.Value, Chr(10)) - 1).Font .ColorIndex = 3 End With End Sub 選択セルのすべてに対し、一括で書式設定できるようにするにはどうしたらよいでしょうか?ご回答よろしくお願いいたします。

  • エクセルVBAで任意の文字列を抽出するには・・・

    エクセル2003で作成した住所録があります。 県名(3文字)のみを抽出して、新たに設けたD列に表示させたいと考えています。 Sub 県名の列作成()  Dim myStr As String  myStr = ActiveCell.Value  Range("D2").Value = Left(myStr,3) End Sub ここまで、できたのですが・・・・ B列の2行目から順に処理をして、一覧表の最後まで行って、 空白セルの行が見つかったら終了させる方法が分かりません。 どうかよろしくお願いします。

  • VBA 別のシートから文字列参照して全て表示

    ExcelのVBAでSheet1のA3に5文字の文字列(大文字、小文字を区別しない)を入力してSheet2のC列にあるA3の文字列から始まるデータ(10文字以上)をすべてを参照してSheet2のD列を含めSheet1のA5,B5から下にすべて表示させる。 宜しくお願い致します。 Sub macro1() Dim V2 As Variant V1 = Sheets("sheet1").Cell("A3").Value '文字列を取得 V2 = Application.InStr(Sheets("sheet2").Range("C:C"), V1) '検索するテーブルでC列の文字列を探す 'みつけたら、その行、無かったら、エラーのコードが変数に入る If IsError(V2) Then 'テーブルに無かったらなにもしない Else str0 = Worksheets("Sheet2").Cells(V2, 7).Value str1 = Worksheets("Sheet2").Cells(V2, 8).Value str2 = Worksheets("Sheet2").Cells(V2, 9).Value Worksheets("sheet1").Cells(i, 2).Value = str0 Worksheets("sheet1").Cells(i, 3).Value = str1 Worksheets("sheet1").Cells(i, 4).Value = str2 End If End Sub

  • VBAについて(カッコをとりたい)教えて下さい。

    VBA初心者です。 こちらで教えて頂きながらマクロを組んでいます。 また1点アドバイスをお願い致します。 N列に()の付いた文字列が所々入ります。 その()だけをとって中の文字列だけを表示したいのですが… (△△△)→△△△ ※カッコ内の文字数は定まっていません。 以下の様なマクロを組みましたが、範囲をN列全部、 またはN4~N列最終行までとしたいのですが、 どの様に追記したらよいでしょうか??? どなたかご指導をお願い致します。 Sub カッコをとる() Dim str As String With ActiveSheet str = .Range("N11") .Range("N11").Value = Mid(str, 2, Len(str) - 2) End With End Sub

  • エクセルのセルの一部の色を変更したい

    エクセル2000でマクロを作っていて質問です。 セルの一部を選択した状況から、選択した文字列だけ色を赤字に変えるというプログラムはどのように書けばよいでしょうか? ActiveCell.Characters(Start:=1, Length:=33).Font.colorindex = 9のSTARTとLENGTHを、現在選択している先頭と長さ、というように指定したいのですが。 ちなみに勉強の意味もあってプログラムを書いていますので、バーのボタン押したらいいじゃん、という冷静な意見はご勘弁を。

専門家に質問してみよう