スキルアップ・問題解決なら、モーグにおまかせ！

やりたいこと
 
給与シートの１行目が見出しとなっていて、赤くなっているセルがいくつかあります。
その赤くなったセルの見出しを各シートから探してそのセルも赤くしたいです。
 
シートは配列に格納して回します。
問題はどうやって赤くなったセルを格納してそのセルと一致したセルを各シートから探せばよいかということなのですが、このように各見出しをループさせてまず、給与データの赤見出しを判定
更にその赤見出しと各シートの見出しが一致
一致したセルをrng4に格納
そのrng4を赤くする
 
このようなことは可能でしょうか？シートが複数あるため、rngに格納するのは現実的ではないでしょうか。ほかによい方法があればご教示願います。
 
 
    For r = 2 To UBound(ary1, 2) '給与データ見出し
     
        For c = 2 To UBound(ary2, 2) '各シート見出し
     
             If rng2.Cells(1, c).Interior.Color = vbRed Then '給与データの1行目の背景が赤色の場合
                 
                If ary2(1, c) = ary1(1, r) Then '給与データの赤見出しと各シートの見出しが一致
 
                  If rng4 Is Nothing Then
                 
                    Set rng4 = rng1.Cells(1, r)
                   
                 
                  Else
                 
                    Set rng4 = Union(rng4, rng1.Cells(1, r))
                   
                  

配列にこだわりがあるような印象を受けますが、
このケースでは必要性を私は感じないですね。
読み出しだけなら、直接セルからでもそんなに遅くないです。
 
同じセルに何度もアクセスしない様に工夫するのは当然。

'一例：
    Dim dicT As Object, WsPR As Worksheet, ws As Worksheet, rng As Range
    
    Set dicT = CreateObject("Scripting.Dictionary")
    
    Set WsPR = Worksheets("給与")
    
    With Intersect(WsPR.Rows(1), WsPR.UsedRange)
        For r = 2 To .Columns.Count
            If .Cells(1, r).Interior.Color = vbRed Then '給与のタイトルが赤なら
                dicT(.Cells(1, r).Value) = Empty '赤の項目名を登録
            End If
        Next
    End With
    
    For Each ws In ThisWorkbook.Worksheets
    
        If ws.Name <> "給与" Then
            Set rng = Intersect(ws.Rows(1), ws.UsedRange)
            rng.Offset(, 1).Interior.Color = xlNone '事前無色化
            
            For c = 2 To rng.Columns.Count
            
                If dicT.exists(rng(1, c).Value) Then '給与の赤見出しと各シート見出しが一致
                    If rng4 Is Nothing Then
                        Set rng4 = rng(1, c)
                    Else
                        Set rng4 = Union(rng4, rng(1, c))
                    End If
                End If
            Next c
            
            rng4.Interior.Color = vbRed
            Set rng4 = Nothing
        End If
    Next ws

提示されたコードは、
コメントと、コード 間で齟齬がある様に感じます。
何をやりたいのか 判りかねますが
 

引用:
給与シートの１行目が見出しとなっていて、赤くなっているセルがいくつかあります。
その赤くなったセルの見出しを各シートから探してそのセルも赤くしたいです。

Sub Sample()
  Dim wst As Worksheet
  Dim rng As Range
  Dim rngs As Range
  Dim i As Long
  Dim Ary As Variant

'ワークシート給与
' 1行目中 背景 赤 セルの値を 配列 ary に代入
  With Application.FindFormat
    .Clear
    .Interior.Color = vbRed
  End With

  With Worksheets("給与").Rows(1)
    Set rng = .Find(what:="", SearchFormat:=True)
    If Not rng Is Nothing Then
      i = rng.Column
      Do
        If IsArray(Ary) Then
          ReDim Preserve Ary(UBound(Ary) + 1)
          Ary(UBound(Ary)) = rng.Value
        Else
          ReDim Ary(0)
          Ary(0) = rng.Value
        End If
        Set rng = .Find(what:="", after:=rng, SearchFormat:=True)
      Loop While rng.Column <> i
    End If
  End With
  Application.FindFormat.Clear


'ワークシート 給与 以外
' 1行目中 セル値が、ary の値と合致したセル を
' rngs に代入し、背景色を赤に設定
  For Each wst In ThisWorkbook.Worksheets
    If wst.Name <> "給与" Then
      Set rngs = Nothing
      For i = LBound(Ary) To UBound(Ary)
        Set rng = wst.Rows(1).Find(what:=Ary(i))
        If Not rng Is Nothing Then
          If rngs Is Nothing Then
            Set rngs = rng
          Else
            Set rngs = Application.Union(rngs, rng)
          End If
          Set rng = wst.Rows(1).FindNext(after:=rng)
        End If
      Next i
    End If
    If Not rngs Is Nothing Then
      rngs.Interior.Color = vbRed
    End If
  Next wst
End Sub

    
    For Each ws In ThisWorkbook.Worksheets
     
        If ws.Name <> "給与" Then
            Set rng = Intersect(ws.Rows(1), ws.UsedRange)
            rng.Offset(, 1).Interior.Color = xlNone '事前無色化
             
            For c = 2 To rng.Columns.Count
 
 
 大変お世話になっております。
一つご教示願います。
rngですが、シートの中にはそもそもセルが入っていないものもあります。
その場合、rngが空白のため、エラーで返ってきてしまいます。
この場合、nothingで指定すればよいかと思うのですが、どのように記述すべきでしょうか。

見込み と 手抜きで書いてしまいました。
ループは、こうした方が確実性が高いです。
 

 For Each ws In ThisWorkbook.Worksheets
     If ws.Name <> "給与" Then
         Set rng = Intersect(ws.Rows(1), ws.Range("A1:B1", ws.UsedRange.Address))
         rng.Offset(, 1).Resize(1, rng.Columns.Count - 1).Interior.Color = xlNone '無色化
         
         For c = 2 To rng.Columns.Count
             
             If dicT.exists(rng(1, c).Value) Then '給与の赤見出しと各シートの見出しが一致
                 If rng4 Is Nothing Then
                     Set rng4 = rng(1, c)
                 Else
                     Set rng4 = Union(rng4, rng(1, c))
                 End If
             End If
         Next c
         
         If Not rng4 Is Nothing Then
             rng4.Interior.Color = vbRed
             Set rng4 = Nothing
         End If         
     End If
 Next ws

 rng.Offset(, 1).Resize(1, rng.Columns.Count - 1).Interior.Color = xlNone '無色化
 
度々、申し訳ございません。
こちらのコードがエラーになってしまい、オブジェクト変数またはwtihブロック変数が設定されておりません。となります。
 
こちらのコードですが、どのような内容でしょうか？
 
wsのシートの中には見出しも入っていないシートもあります。この場合usedrangeはエラーになるでしょうか。
そういったシートは参照しなくてもよいです。

＞wsのシートの中には見出しも入っていないシートもあります。
それは考慮したコードに変更してあります。(※)
 
＞rng.Offset(, 1).Resize(1, rng.Columns.Count - 1).Interior.Color = xlNone '無色化
＞こちらのコードですが、どのような内容でしょうか？
(※)見出しが無いとか、空シートとかでも、最小限A1:B1の２セルは考慮対象にするものです。
 
こちらでは何の問題も発生しておりません。ただ、原因究明するより、
Suzuさんからコードが提示されておりますので、そちらを採用頂く方が話が早いと思います。

[quote="半平太"]＞wsのシートの中には見出しも入っていないシートもあります。
それは考慮したコードに変更してあります。(※)
 
申し訳ありません。私が間違っておりました。コードは正常に動くので、こちらで解決となります。
 
この後は質問というか今後に活用していきたいと思いますのでお付き合いいただけると幸いです。
 
  Set rng = Intersect(ws.Rows(1), ws.Range("A1:B1", ws.UsedRange.Address))
 
ここの使い方なのですが、intersectで、”a1:b1"とwsの使われているrangeを格納しているという認識で合っておりますか。なぜaddressで指定しているのでしょうか？
 
inrersectは複数のrangeを格納できるのですね。初めて知りました。
 
rng.Offset(, 1).Resize(1, rng4.Columns.Count - 1).Interior.Color = xlNone
 
そしてここですが、rngと書かずにoffsetで1列ずらし、更にresizeで範囲をoffsetで１列ずらしたところから最終列の１つ前までと指定しているのですが、結果usedrangeの範囲と一緒になります。
resizeすると最終列を指定してもずれてしまうため、-1をしているのですね。
このように記述する通常に記述するよりどのように良いことがあるのでしょうか？
 

＞”a1:b1"とwsの使われているrangeを格納しているという認識で合っておりますか。
 それは飛び飛びの範囲との解釈でしょうが、
「a1:b1」と「wsの使われているrange」の両者を包含する単一の矩形範囲です。
 
 こちらでは、実際のシートがどのように作成され、
 そこにデータがどの様に配置されたのか不明なので、
 保険を掛けた範囲指定です。
 
＞なぜaddressで指定しているのでしょうか？
その必要はなかったです。　m(__)m
 
＞結果usedrangeの範囲と一緒になります。
＞このように記述する通常に記述するよりどのように良いことがあるのでしょうか？
一緒とは限らないと思っています。
ただ へんてこりんな書き方をしていると思われても仕方がないです。
特にいいこともありません。理由は以下の通りです。
 
上述しましたが、そちらのデータの在り様が不明なので
あれこれ保険を掛けながら書くしかない為です。
※シートは新規作成もあるかも知れないな。
　データはA1から入力されていないかも知れないな(UsedRangeがA1から始まっていないかも）
　A1セルが今回の処理とは無関係に、赤色だったら事前処理で無色にするのはマズいな。

引用:
ここの使い方なのですが、intersectで、”a1:b1"とwsの使われているrangeを格納しているという認識で合っておりますか。なぜaddressで指定しているのでしょうか？
inrersectは複数のrangeを格納できるのですね。初めて知りました。

お返事が遅くなってしまい申し訳ございません。
頂いたコードも大変便利なものです。
知識の向上のためにぜひ活用させていただきます。
 
今後ともよろしくお願いいたします。

お忙しい中、ご説明いただきありがとうございます。
大変参考になりました。
知識不足で今後もお聞きすることが多くなるかもしれませんが、何卒よろしくお願いいたします。

# 回答があったら、きちんと返事をする（試行して結果の成否等を返事する）のが
# 礼儀だと思いますが、いかがですか？
# Suzuさんも時間を割いて、ボランティアであなたに回答されています。[/quote]
 
 
おっしゃっていることは至極ごもっともで、否定のしようもないです。
が、あなたにそんなことを言われる筋合いはないというか、、、こちらもサイトを見る時間も作れなかったというのが現状です。
度々お返事いただいてありがたいのですがね。

お忙しい中ありがとうございました。
今後とも何卒よろしくお願いいたします。