[[20150626161424]] 『複数条件』(setuna) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『複数条件』(setuna)

B列に”A”と入っていれば、同じ行のD列〜G列すべてが”100”と入っているかどうか入力のある行まで調べたいです。
Aが入っているかどうかはできたんですが・・・

    For i = 3 To Cells(Rows.Count, "B").End(xlUp).Row
        If Range("B" & i).Value = "A" Then
            msgbox "Aがはいっている"
        End If
    Next i

ご教示お願いします。

< 使用 Excel:Excel2010、使用 OS:Windows7 >


こんにちは

こんな感じで、

Sub test0()

    Dim i As Long
    For i = 3 To Cells(Rows.Count, "B").End(xlUp).Row
        If Range("B" & i).Value = "A" Then
            If Range("D" & i).Value = 100 Then
                If Range("E" & i).Value = 100 Then
                    If Range("F" & i).Value = 100 Then
                        If Range("G" & i).Value = 100 Then
                            MsgBox "対象行:" & i
                            Exit For
                        End If
                    End If
                End If
            End If
        End If
    Next i
End Sub

Sub test1()

    On Error Resume Next
    With Range("B1", Cells(Rows.Count, "B").End(xlUp))
        MsgBox Evaluate("MATCH(""A 100 100 100 100""," & _
            "INDEX(" & .Address(0, 0) & _
                    "&"" ""&" & .Offset(, 2).Address(0, 0) & _
                    "&"" ""&" & .Offset(, 3).Address(0, 0) & _
                    "&"" ""&" & .Offset(, 4).Address(0, 0) & _
                    "&"" ""&" & .Offset(, 5).Address(0, 0) & _
                    ",),0)")
    End With
    If Err.Number <> 0 Then MsgBox "対象なし"
    On Error GoTo 0
End Sub

(ウッシ) 2015/06/26(金) 16:55


こんな感じも
Sub Macro1()
'
Dim i As Long
Dim cnt As Long
For i = 3 To Cells(Rows.Count, "B").End(xlUp).Row
        If Range("B" & i).Value = "A" Then
        cnt = WorksheetFunction.CountIf(Range("D" & i & ":G" & i), 100)
           If cnt = 4 Then
           MsgBox "ok"
           End If
        End If
    Next i
'
End Sub
(デイト) 2015/06/26(金) 16:58

 6/27 15:15 If i = 0 Then を If x = 0 Then に訂正。

 あるいは

 Sub Sample()
    Dim x As Long
    Dim z As Long
    Dim w As Variant
    Dim i As Long

    z = Range("B" & Rows.Count).End(xlUp).Row
    ReDim w(1 To z)
    For i = 3 To z
        If Not Evaluate("IF(B" & i & "=""A"",COUNTIF(D" & i & ":G" & i & ",100)=4,TRUE)") Then
            x = x + 1
            w(x) = i
        End If
    Next
    If x = 0 Then
        MsgBox "OK"
    Else
        ReDim Preserve w(1 To x)
        MsgBox "以下の行で不整合" & vbLf & Join(w, vbLf)
    End If

 End Sub

(β) 2015/06/26(金) 17:29


調べた結果どうするかにもよりますが、
フィルター(詳細設定)で抽出してみました。

 Sub test()
    Dim リスト As Range
    Dim 検索条件 As Range
    Dim n As Long

    Set リスト = ActiveSheet.Range("A2").CurrentRegion

    With リスト.Offset(リスト.Rows.Count + 1).Cells(1)
        リスト.Rows(1).Copy .Cells
        .Offset(1, 1).Resize(4).Value = "A"
        .Offset(1, 3).Value = "<>100"
        .Offset(2, 4).Value = "<>100"
        .Offset(3, 5).Value = "<>100"
        .Offset(4, 6).Value = "<>100"
        Set 検索条件 = .CurrentRegion
    End With

    リスト.AdvancedFilter xlFilterInPlace, 検索条件
    検索条件.ClearContents

    n = リスト.Columns(1).SpecialCells(xlCellTypeVisible).Count - 1
    If n > 0 Then
        MsgBox "不適合" & n & "件抽出"
    Else
        MsgBox "すべて適合"
        リスト.Parent.ShowAllData
    End If

 End Sub

(マナ) 2015/06/27(土) 16:23


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.