[[20150630101942]]　『エラーチェック』（弘子）　ページの最後に飛ぶ

『エラーチェック』（弘子）

Ｃ列に有と書いてある場合に、Ｈ列～ＣＤ列まで、全て”○”と入力されているかどうか調べたいです。○と入力されていないセルがあった場合、そのセルのエラーメッセージをだしたいです。この、セルを取り出す方法を教えてください。お願いします。（.Address　←　これをどう使えばセルが拾えるのかが分かりません）

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 マクロで行いたい、ということでしょうか？
（カリーニン） 2015/06/30(火) 10:26

カリーニンさん

はいその通りです。どうかよろしくお願いします。
（弘子） 2015/06/30(火) 10:31

 以下は、○が欠落しているセルを表示せず、欠落していた行を表示しています。
 やはり、欠落セルの表示がほしいということならコードを直しますが。

 Sub Test()
    Dim c As Range
    Dim myFormula As String
    Dim n As Long
    Dim w As Variant
    Dim x As Long
    Dim fmx As String

    ReDim w(1 To Rows.Count)
    myFormula = "AND(C%=""有"",COUNTIF(H%:CD%,""○"")<75)"
    For Each c In Range("C1", Range("C" & Rows.Count).End(xlUp))
        fmx = Replace(myFormula, "%", c.Row)
        If Evaluate(fmx) Then
            x = x + 1
            w(x) = c.Row
        End If
    Next

    If x = 0 Then
        MsgBox "すべてＯＫ"
    Else
        ReDim Preserve w(1 To x)
        MsgBox "以下の行に不足あり" & vbLf & Join(w, vbLf)
    End If

 End Sub

（β） 2015/06/30(火) 11:25

 欠落したセルのアドレスをすべて表示するなら

 Sub Test2()
    Dim c As Range
    Dim myFormula As String
    Dim n As Long
    Dim w As Variant
    Dim x As Long
    Dim fmx As String
    Dim z As Long
    Dim v As Variant
    Dim r As Range

    ReDim w(1 To Rows.Count)
    myFormula = "AND(C%=""有"",COUNTIF(H%:CD%,""○"")<75)"
    For Each c In Range("C1", Range("C" & Rows.Count).End(xlUp))
        fmx = Replace(myFormula, "%", c.Row)
        If Evaluate(fmx) Then
            ReDim v(1 To 75)
            z = 0
            For Each r In c.EntireRow.Range("H1:CD1")
                If r.Value <> "○" Then
                    z = z + 1
                    v(z) = r.Address(False, False)
                End If
            Next

            If z > 0 Then
                x = x + 1
                ReDim Preserve v(1 To z)
                w(x) = Join(v, ",")
            End If
        End If
    Next

    If x = 0 Then
        MsgBox "すべてＯＫ"
    Else
        ReDim Preserve w(1 To x)
        MsgBox "以下のセルがおかしいよ" & vbLf & Join(w, vbLf)
    End If

 End Sub

（β） 2015/06/30(火) 11:37

ありがとうございます！！
分かり易くとても助かりました
（弘子） 2015/06/30(火) 13:22

コメント返信：

[ 一覧(最新更新順) ]

[[20150630101942]] 『エラーチェック』（弘子） ページの最後に飛ぶ

[[20150630101942]]　『エラーチェック』（弘子）　ページの最後に飛ぶ