|
他にどんな定義があるのかわからないので分岐の一例です。
分岐の部分だけ修正したものです。mainは前回のままなので載せていません。
Sub Check8and9(wb As Workbook)
Dim RR&, Rmax&, Rpos&, II%, Rec$
Dim ws(1 To 2) As Worksheet
'
Set ws(1) = ThisWorkbook.Worksheets("Sheet4")
ws(1).Cells.Clear 'Sheet4を初期化
Rpos& = 0 '書き出すときは上詰めで
'開始
On Error Resume Next
'『Sheet8&9』を検索ということ?
Set ws(2) = wb.Worksheets("Sheet8&9")
On Error GoTo 0
'『Sheet8&9』というシートが無かったらその後の処理は無し
If Not ws(2) Is Nothing Then
With ws(2).UsedRange
Rmax& = .Cells(.Count).Row
End With
For RR& = 8 To Rmax&
'AFが0以外の時
If ws(2).Cells(RR&, 32).Value <> 0 Then
With ws(2)
Rec$ = .Cells(RR&, 11).Value & .Cells(RR&, 13).Value & _
.Cells(RR&, 14).Value & .Cells(RR&, 18).Value
End With
'
If Rec$ = "" Or Rec$ = "1A11" Then
'空白セルまたは条件に合致した場合はなにもしない
Else
Rpos& = Rpos& + 1
With ws(1)
For II% = 1 To 3
.Cells(Rpos&, II%).Value = _
ws(2).Cells(RR&, II% + 3).Value
Next
With .Cells(Rpos&, 4)
Select Case Rec$
Case "1A10"
.Value = "不具合A"
.EntireRow.Font.ColorIndex = 3
Case "1B10"
'たとえばM列の値がBの場合の分岐例
.Value = "不具合B"
.EntireRow.Font.ColorIndex = 3
Case Else
'定義漏れかつO列に×が入っているものの抽出例
If ws(2).Cells(RR&, 15).Value = "×" Then
.Value = "定義漏れ×"
.EntireRow.Font.ColorIndex = 44
Else
.Value = "定義漏れ"
.EntireRow.Font.ColorIndex = 44
End If
End If
End With
'おまけ
.Cells(Rpos&, 5).Value = RR& '元の行番号
End With
End If
End If
Next
Set ws(2) = Nothing
End If
'結果表示
ThisWorkbook.Activate
ws(1).Activate
Erase ws
End Sub
こんな感じです。
条件を全て満たすかどうかについて、連結した文字列にして判定する方法以外ならば、And 演算子を使って論理積を求めればいいです。
Sub test()
Dim tf As Boolean, I As Integer
For I = 8 To 10
tf = (Cells(I, 11).Value = 1) And _
(Cells(I, 13).Value = "A") And _
(Cells(I, 14).Value = 1) And _
(Cells(I, 18).Value = 1)
If tf Then
MsgBox "一致", vbInformation, I & "行目"
Else
MsgBox "不一致", vbInformation, I & "行目"
End If
Next
End Sub
直接If文でも同じこと
Sub test()
Dim I As Integer
For I = 8 To 10
'
If (Cells(I, 11).Value = 1) And (Cells(I, 13).Value = "A") And _
(Cells(I, 14).Value = 1) And (Cells(I, 18).Value = 1) Then
MsgBox "一致", vbInformation, I & "行目"
Else
MsgBox "不一致", vbInformation, I & "行目"
End If
Next
End Sub
|
|