[[20181228012959]]　『VBAでセルの塗りつぶし』（ゆかりん）　ページの最後に飛ぶ

『VBAでセルの塗りつぶし』（ゆかりん）

ご教示お願いします。

R列（R1からR40程度）を検索して、特定の文字"○"があった場合に
同行のセルを複数ピンク色に塗り潰したいのです。

例えばR8に"○",R24に"○"があった時にそれぞれA8～J8,A24～J24セルを
塗り潰したいのです。

過去ログに類似した質問もあるかもしれませんが、全くの初心者ですので
ピンポイントで教えて頂けると助かります。
どうぞ宜しくお願いいたします。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 条件付き書式ではだめなのでしょうか？
 条件付き書式ならA1セルからJ40セルを選択した状態で

 ホームタブ → 条件付き書式 → 新しいルール → 「数式を使用して～」を選択
 =$R1="○"
 書式をクリックして塗りつぶしタブから色を選択

 でできますが。
（bi） 2018/12/28(金) 07:27

とりあえず、単純にA8～J8をピンクに塗りつぶす方法はわかりますか？
わからなければ、マクロの記録　機能を使ってしらべてみてください。

条件分岐の方はいろいろあるとおもいますが、一例を提示します。
ステップ実行して研究してみてください。

    Sub Sample()
        Dim MyRNG As Range

        For Each MyRNG In Range("R1", Cells(Rows.Count, "R").End(xlUp))
            If MyRNG.Value Like "*○*" Then
                Debug.Print Range(Cells(MyRNG.Row, "A"), MyRNG).Address(0, 0)
            End If
        Next

    End Sub

（もこな２） 2018/12/28(金) 07:35

 こんな感じで。
 Sub TEST()
    '変数rwをlong型で宣言（行番号格納用）
    Dim rw As Long
    'R列の1行目からデータのある最下行まで繰り返す
    For rw = 1 To Range("R" & Rows.Count).End(xlUp).Row
        'R列の値に「○」が含まれていたら
        If InStr(Range("R" & rw).Value, "○") > 0 Then
            'A～J列の同じ行をピンクに塗りつぶす
            Range(Range("A" & rw), Range("J" & rw)).Interior.Color = 16738047
        End If
    Next rw
 End Sub
（ろっくん） 2018/12/28(金) 08:37

 参加！
    Sub pink()
        Dim f As Variant
        Range("A1:J40").Interior.Color = xlNone
        f = Evaluate("IF(R1:R40=""○"",""A""&ROW(1:40)&"":J""&ROW(1:40),CHAR(2))")
        f = Application.Transpose(f)
        f = Filter(f, Chr(2), False)
        f = Join(f, ",")
        If f <> "" Then
            Range(f).Interior.Color = RGB(234, 145, 152)
        End If
    End Sub
（稲葉） 2018/12/28(金) 09:08

 おはようございます。
記録しただけですけど、、、(^^;
Sub てすと()
Dim MyRng As Range
Set MyRng = Range("A8:J24")
    With MyRng
        .Cells(1).Activate
        .FormatConditions.Delete
        .FormatConditions.Add Type:=xlExpression, Formula1:="=$R8=""〇"""
        .FormatConditions(.FormatConditions.Count).SetFirstPriority
        With .FormatConditions(1).Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent6
            .TintAndShade = 0.399945066682943
        End With
    End With
Set MyRng = Nothing
End Sub
すみません　ちょっと訂正しました。
何時も
.Cells(1).Activate
これを忘れるんですよねぇ
どうにかして左上端を選択しておいてください。
（SoulMan） 2018/12/28(金) 09:59

 Sub test()
    Dim i As Long
    With ThisWorkbook.Sheets("Sheet1")
       For i = 1 To .Cells(.Rows.Count, "R").End(xlUp).Row
           If .Cells(i, "R") Like "*○*" Then
              .Cells(i, "A").Resize(1, 10).Interior.Color = 13551615
           End If
       Next i
    End With
 End Sub

（TAKA） 2018/12/28(金) 10:23

お礼が遅くなり申し訳ございません。
皆様ありがとうございました。
思い通りの事ができました。
色々な手法があるのですね！助かりました！
また何かあれば宜しくお願いいたします。

ゆかりん
（ゆかりん） 2018/12/29(土) 09:53

前回はたくさんの方にお世話になりました。
皆様のコードに条件分岐を加筆して上手くいったのですが
そこで、また行き詰まりました。。
("Sheet1")だけでなく複数のシートに同じ動作を行いたいのです。

Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Selectなどを見つけて
加筆したのですが全然上手くいきません。
どのモジュールに書くべきかもよくわかりません。
再度ご教示頂ければと思います。
（ゆかりん） 2018/12/30(日) 01:12

とりあえず、どのように変えたのか”全体を”提示いただくとアドバイスできることがあるかもしれません。

（もこな２） 2018/12/30(日) 02:27

 おはようございます。
なんか年末であわただしくなってきましたね

 ところで方法は、いくつかあるでしょうが
 >Sheets(Array("Sheet1", "Sheet2", "Sheet3")).
なのでしたくないSheetもおありでしょうから
取り敢えず、ループしてあったら実行ってな感じにしましょうかね

 で、今日は「簡単」のことを「ねこふんじゃった」っていうでしょ？
これは何故かしってますぅ？(そんなんどないでもええから早よ本題にいかんかえ！おっさん！はい、すみません）
関西人特有の突込みがないと本題に入れないんですよね(^^;

 で、これはその昔、柔道一直線(古いねぇ(笑)）の近藤正臣扮する結城慎吾が一条直也の誘いを断った時に
ピアノの上にぴょんと飛び乗って脚の指で　♪猫踏んじゃった　を弾いたんですね
(今からするとびっくりするようなシーンですね）

 このことから、難しいことを難なくこなす=簡単=♪猫踏んじゃった　となったんですね←これわたしの定説です。(笑)

 なので、今回の事例は、こちらの学校の先生がたからすると、多分、「こんなの♪猫踏んじゃったやん」

 だと思います。(￣▽￣;)

 ではでは、本日は妻に連れられてお買い物に大掃除にと不通になるかもしれませんが、
お許しくださいませ。

 では、よいお年を迎えてください。

 Sub てすと()
Dim MyRng As Range
Dim ws As Worksheet
Dim MyAry As Variant
Dim x As Variant
MyAry = Array("Sheet1", "Sheet2", "Sheet3")
For Each ws In ThisWorkbook.Worksheets
    x = Application.Match(ws.Name, MyAry, 0)
    If Not IsError(x) Then
        Set MyRng = ws.Range("A8:J24")
        With MyRng
            Application.Goto .Cells(1)
            .FormatConditions.Delete
            .FormatConditions.Add Type:=xlExpression, Formula1:="=$R8=""〇"""
            .FormatConditions(.FormatConditions.Count).SetFirstPriority
            With .FormatConditions(1).Interior
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = 0.399945066682943
            End With
        End With
    End If
Next
Set MyRng = Nothing
Erase MyAry
End Sub
（SoulMan） 2018/12/30(日) 08:15

Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Selectなどを見つけて複数のシートがSheet1,Sheet2,Sheet3 なら
Sub Test()

    Dim ws As Worksheet, c As Range

    For Each ws In Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
        For Each c In ws.Range("R1", ws.Cells(Rows.Count, "R").End(xlUp))
            If InStr(c.Value, "○") Then
                ws.Cells(c.Row, "A").Resize(, 10).Interior.Color = vbMagenta
            End If
        Next c
    Next ws
End Sub

（ピンク） 2018/12/30(日) 08:33

 複数のシートがSheet1,Sheet2,Sheet3 なら 
Sub Test()
    Dim ws As Worksheet, c As Range

    For Each ws In Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
        For Each c In ws.Range("R1", ws.Cells(Rows.Count, "R").End(xlUp))
            If InStr(c.Value, "○") Then
                ws.Cells(c.Row, "A").Resize(, 10).Interior.Color = vbMagenta
            End If
        Next c
    Next ws
End Sub

（ピンク） 2018/12/30(日) 08:36

 ほらね
猫ふんじゃっただったでしょ(笑)
ピンクさん　勉強になります。
ありがとうございました。
（SoulMan） 2018/12/30(日) 08:43

（もこな２）様、（SoulMan）様、（ピンク）様
年の瀬のお忙しい時に本当にありがとうございました。
皆様のおかげで全て上手く作動しました！

そうですね、まずは教本でも買ってゆっくり基礎から
勉強してみます。また疑義が生じたらこちらのサイトで
お世話になりたいと思いますので、その時はまた宜しくお願いいたします。
（ゆかりん） 2018/12/30(日) 19:16

コメント返信：

[ 一覧(最新更新順) ]

[[20181228012959]] 『VBAでセルの塗りつぶし』（ゆかりん） ページの最後に飛ぶ

[[20181228012959]]　『VBAでセルの塗りつぶし』（ゆかりん）　ページの最後に飛ぶ