こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

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

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

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

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

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

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

よろしくお願いします。

投稿日時 - 2018-01-08 17:32:52

QNo.9416309

暇なときに回答ください

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

提示のデータ範囲で検証してみました。
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のマニュアルを辞書代わりに使うことで徐々に上達すると思います。
簡単な処理から順次高度な処理まで気長に学習することをお薦めします。
「質問」より「自力で調べながら解決」を選択してください。

投稿日時 - 2018-01-09 15:27:09

お礼

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

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

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

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

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

投稿日時 - 2018-01-10 16:40:51

ANo.5

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(6)

ANo.6

 小出しにするのはやめてくれ。
 条件1が空白でなく、条件2か空白、又はその逆がありうるのか? あった場合どうするのかが書いていない。このようなことがあれば矛盾が生じるので、無いという設定で作った。
'
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

投稿日時 - 2018-01-09 22:32:57

お礼

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

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

投稿日時 - 2018-01-11 23:16:37

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

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

で、たまにデータによって、320行・・・もアウトです。全部で305行とします。

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

投稿日時 - 2018-01-09 10:36:18

ANo.3

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

投稿日時 - 2018-01-09 07:40:10

補足

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


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

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

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


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

投稿日時 - 2018-01-09 15:59:17

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

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

投稿日時 - 2018-01-08 18:26:04

補足

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

実際に検索をするデータ表での行数は302行です。16行目から317行目までです。

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

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

よろしくお願いします。

投稿日時 - 2018-01-08 23:04:09

ANo.1

'
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

投稿日時 - 2018-01-08 18:17:01

補足

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

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

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

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


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

投稿日時 - 2018-01-09 00:25:12