VBA 指定条件を満たすデータ表を探したい

質問

VBA初心者です。
以下のような事をVBAで実現したいのですが、どのようにすればいいのでしょうか。
（本日のお昼頃に似たような質問をして早速回答をいただき解決しました。ありがとうございました。今回は条件の表示位置などが異なる場合です。）

添付画像のような数値データ表があります。

データ表が１から５まであります。
左上にそれぞれのデータ表での数値の検索条件１と２が記載されています。

データ表１は548以上になる位置を上から順に探していき、その数値以上になった時点でセルに色を付けたいです。そしてG列の条件１のセルに「合致」と表示したいです。
条件２の535以下は条件１を満たしたセルの次の行から検索をさせたいです。
（データ表１の場合は２２行目からです。）
そして、条件２を満たすものが出たらセルに色を付け、H列の条件２に「合致」と表示したいです。

また、例えばデータ表３とデータ表４の場合は条件２で合致するものがないのですが、その場合は
H列の条件２に「該当なし」と表示したいです。

よろしくお願いします。

回答No.5

bunjii · ベストアンサー

提示のデータ範囲で検証してみました。
Sub value_check()
Range("A1:Z100").Interior.ColorIndex = 0
Range("G2:H6").Value = Null
MsgBox "前回の結果をクリアしました"
Dim r, c, i, j
For r = 2 To 6
c = (Cells(r, 1) - 1) * 4 + 2
For i = 12 To 26
If Cells(i, c) >= Cells(r, 4) Then
Cells(i, c).Interior.ColorIndex = 38
Cells(r, 7) = "合致"
For j = i + 1 To 26
If Cells(j, c + 1) > 0 And (Cells(j, c + 1) <= Cells(r, 6)) Then
Cells(j, c + 1).Interior.ColorIndex = 28
Cells(r, 8) = "合致"
j = 26
Else
Cells(r, 8) = "不一致"
End If
Next j
i = 26
End If
Next i
Next r
End Sub
結果の画像を貼付します。
チェック対象の表3と表4に空欄を設けて除外の確認も含めてあります。
コードを解読できる知識が無ければ仕様変更に対応できないでしょう。
VBAのマニュアルを辞書代わりに使うことで徐々に上達すると思います。
簡単な処理から順次高度な処理まで気長に学習することをお薦めします。
「質問」より「自力で調べながら解決」を選択してください。

お礼

ご回答ありがとうございます。

サンプル表をご自身で作成して検証していただきありがとうございました。

bunjii 様に教えていただいたコードで、私が現時点で実現したい事はすべて出来ました。

実際のデータ表に適用するために、コードを修正して検索対象範囲を広げる事と、対象となるデータ表をもう一つ右側に増やす事は出来ました。
浅い知識なのでこの程度までしか今は無理そうです。
ご指摘いただいたように、VBAのマニュアルを辞書代わりにして少しずつ学んでいこうと思います。

ありがとうございました。

回答No.6

SI299792

小出しにするのはやめてくれ。
　条件１が空白でなく、条件２か空白、又はその逆がありうるのか？　あった場合どうするのかが書いていない。このようなことがあれば矛盾が生じるので、無いという設定で作った。
'
Option Explicit
'
Sub Macro1()
'
　　Dim Row1 As Integer
　　Dim Row2 As Integer
　　Dim Col As Integer
　　Dim WkString As String
'
　　[A12:S26].Interior.Pattern = xlNone
　　[G2:H6].ClearContents
'
　　For Row1 = 2 To 6
'
　　　　If Cells(Row1, "D") > "" Then
　　　　　　Col = Row1 * 4 - 6
'
　　　　　　WkString = "該当者なし"
　　　　　　For Row2 = 12 To 26
'
　　　　　　　　If Cells(Row2, Col) >= Cells(Row1, "D") Then
　　　　　　　　　　Cells(Row2, Col).Interior.Color = &HFF7FFF
　　　　　　　　　　WkString = "合致"
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next Row2
　　　　　　Cells(Row1, "G") = WkString
'
　　　　　　WkString = "該当者なし"
　　　　　　For Row2 = Row2 + 1 To 26
'
　　　　　　　　If Cells(Row2, Col + 1) > "" And _
　　　　　　　　　 Cells(Row2, Col + 1) <= Cells(Row1, "F") Then
　　　　　　　　　　Cells(Row2, Col + 1).Interior.Color = &HFFFF00
　　　　　　　　　　WkString = "合致"
　　　　　　　　　　Exit For
　　　　　　　　End If
　　　　　　Next Row2
　　　　　　Cells(Row1, "H") = WkString
　　　　End If
　　Next Row1
End Sub

お礼

修正コードを掲載していただきありがとうございました。

今度からは希望条件をすべて最初の質問文に記載します。
お手数をおかけして申し訳ありませんでした。

回答No.4

noname#232800

人間の脳は識別しますが、表計算では無理です。

従って、横方向に表があると、困ります。
で、たまに空白のセルが・・・というのも、人間なら判断できますが、コンピュータには無理です。空白のセルは「０」としましょう。

で、たまにデータによって、３２０行・・・もアウトです。全部で３０５行とします。

ゼロはなく・・・ではなく、自然数の範囲です。

回答No.3

SI299792

空白がある、小数があるなら、そのようにサンプルデータを作ってくれ。空白は飛び飛びにあるのか、空白がデータの終わりで、それ以降データが無いのかの情報も欲しい。
（空白が飛び飛びと想定して作ればなら間違いないが実行速度は落ちる。僅かな差だが）
小数に関しては問題はない。
空白のセルで反応する理由は、空白は０とみなされるから、０は基準値以下なので反応する。下のループ内のIf文を
　　　　　　If Cells(Row1, "F") >= Cells(Row2, Col + 1) And _
　　　　　　　 Cells(Row2, Col + 1) > "" Then
にすれば解決する。

補足

サンプルデータが正確に作成されていなくて申し訳ございません。

空白がデータの終わりになります。空白が表示される行はデータ表によって異なります。

教えていただいた新たなコードで解決しました。ありがとうございました。

あと、もう一点教えていただきたいのですが、条件１と条件２が空白の場合でもG列とH列に合致や該当なしが表示されるのですが、これを条件１と２が空白の場合に表示しないようにするにはどうすればいいでしょうか。

お手数をおかけして申し訳ありませんが、よろしくお願いします。

回答No.2

noname#232800

上から下と言いますが、行数の指定がありません。何行あるのですか？

小数点はあるのですか？
参照値は自然数ですか？　値の範囲が知りたい。
本来５ページとすべきところ、１ページに５表あるのですか？

補足

ご回答ありがとうございます。

実際に検索をするデータ表での行数は３０２行です。１６行目から３１７行目までです。

小数点は第一位まであります。データはすべて正の整数でゼロはありません。
実際のデータ表では１ページに１０表あります。

質問の際の参考画像としてはそれだと表が多すぎるし行数も長すぎるのでサンプルとして似たような表を作成しました。

よろしくお願いします。

回答No.1

SI299792

'
Option Explicit
'
Sub Macro1()
'
　　Dim Col As Integer
　　Dim Row1 As Integer
　　Dim Row2 As Integer
　　Dim WkString As String
'
　　[A12:S26].Interior.Pattern = xlNone
'
　　For Row1 = 2 To 6
　　　　Col = Row1 * 4 - 6
'
　　　　WkString = "該当者なし"
　　　　For Row2 = 12 To 26
'
　　　　　　If Cells(Row1, "D") <= Cells(Row2, Col) Then
　　　　　　　　Cells(Row2, Col).Interior.Color = &HFF7FFF
　　　　　　　　WkString = "合致"
　　　　　　　　Exit For
　　　　　　End If
　　　　Next Row2
　　　　Cells(Row1, "G") = WkString
'
　　　　WkString = "該当者なし"
　　　　For Row2 = Row2 + 1 To 26
'
　　　　　　If Cells(Row1, "F") >= Cells(Row2, Col + 1) Then
　　　　　　　　Cells(Row2, Col + 1).Interior.Color = &HFFFF00
　　　　　　　　WkString = "合致"
　　　　　　　　Exit For
　　　　　　End If
　　　　Next Row2
　　　　Cells(Row1, "H") = WkString
　　Next Row1
End Sub

補足

最初の質問に引き続きご回答ありがとうございます。

実際のデータ表だと行数は16行目から317行目までなのですが、たまにデータによっては320行くらいまである場合があります。
そのため、範囲を16～320としてやってみたのですが、そうすると数値が入っていない空白のセルがF列の第２条件で反応してしまいます。

空白のセルを無視するようにするにはどうすればいいのでしょうか。
あと、回答２の方からのご指摘で小数点や自然数かどうかの記載がないことに気づいたので改めて記載いたします。

データは小数点第一位までで、ゼロは無くマイナスも無いです。

お手数をおかけして申し訳ありませんが、よろしくお願いします。