Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

9052 / 76732

←次へ　｜　前へ→


	【73246】Re:条件に合うセルの色づけ

ウッシ - 12/12/12(水) 14:17 -


	引用なし

	パスワード

こんにちは

DB2のどこを検索するのか分からないですし、判定ロジックもあやふやですけど、

Private f As Range
Sub test()
　　Dim r As Range
　　Dim t As Range
　　Dim b As Boolean
　　
　　'DB2のどこを検索するのか
　　Set t = Worksheets("DB2").Range("A1").CurrentRegion.Columns(1)
　　With Worksheets("DB1")
　　　　For Each r In .Range("B8", .Cells(Rows.Count, 2).End(xlUp))
　　　　　　Select Case r.EntireRow.Range("E1").Value
　　　　　　　　Case "クローズ"
　　　　　　　　　　Select Case r.EntireRow.Range("AL1").Value
　　　　　　　　　　　　Case "オープン"
　　　　　　　　　　　　　　b = False
　　　　　　　　　　　　Case "クローズ"
　　　　　　　　　　　　　　b = Search_DB2(r.EntireRow.Range("AK1").Value, t) * False
　　　　　　　　　　　　Case ""
　　　　　　　　　　End Select
　　　　　　　　Case Else
　　　　　　　　　　Select Case r.EntireRow.Range("AL1").Value
　　　　　　　　　　　　Case "オープン"
　　　　　　　　　　　　　　b = Search_DB2(r.EntireRow.Range("AK1").Value, t) * False
　　　　　　　　　　　　Case "クローズ"
　　　　　　　　　　　　　　b = Search_DB2(r.EntireRow.Range("AK1").Value, t)
　　　　　　　　　　　　Case ""
　　　　　　　　　　End Select
　　　　　　End Select
　　　　　　If b = False Then
　　　　　　　　r.Interior.ColorIndex = 3
　　　　　　End If
　　　　　　Set f = Nothing
　　　　Next
　　End With
End Sub
Function Search_DB2(ByVal s As Variant, Target As Range) As Boolean
　　Set f = Target.Find(s, , xlValues, xlWhole)
　　If f Is Nothing Then
　　　　Search_DB2 = False
　　　　Exit Function
　　End If
　　If f.EntireRow.Range("D1").Value Like "*クローズ*" And _
　　　　　　IsNumeric(f.EntireRow.Range("N1").Value) = True Then
　　　　Search_DB2 = True
　　Else
　　　　Search_DB2 = False
　　End If
End Function

241 hits

▼

【73244】条件に合うセルの色づけ tk 12/12/12(水) 11:25