[[20110708211408]] 『VBAを用いてすべてのシートの特定のセル(複数)の戟x(てん) ページの最後に飛ぶ

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

 

『VBAを用いてすべてのシートの特定のセル(複数)の計算結果が0以外であれば警告が出るようにしたい』(てん)

こんにちは。
ある数値を入力してそれがある値と比較して誤差をチェックする(K27-L27みたいな簡単な式)際に、
その値が0出ない場合に警告がでるようにしたいです。
式が入っているのは列になっていて、さらに複数あります。
色々やってみたんですがだめでした。

WindowsXP、Excel2007を使用しています。

よろしくお願いします。


 たとえばE列の式をチェック。

 Sub Sample()
    Dim c As Range
    Dim r As Range
    Dim s As String
    Dim flag As Boolean

    Set r = Columns("E").SpecialCells(xlCellTypeFormulas, 23)
    If Not r Is Nothing Then
        For Each c In r
            flag = False
            If IsNumeric(c.Value) Then
                If c.Value <> 0 Then flag = True
            Else
                flag = True
            End If
            If flag Then s = s & c.Address(0, 0) & " "
        Next
        If Len(s) = 0 Then
            MsgBox "範囲内の式の結果はすべて0でした"
        Else
            MsgBox "以下のセルの値が0ではありませんでした" & vbLf & s
        End If
    Else
        MsgBox "範囲内に式はありません"
    End If
    Set r = Nothing
 End Sub

 ぶらっと立ち寄り


すみません補足です。

チェックしたいセルはO4,O6〜O25で、エクセルを保存する際にメッセージが出るようにしたいです。

たびたび済みませんがよろしくおねがいします。

上の式は大変参考になりました。ありがとうございました。


 それでは、保存する前にメッセージを。
ThisWorkbookモジュールに以下。シート名は適切なものに。
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    Dim c As Range
    Dim r As Range
    Dim s As String
    Dim flag As Boolean

    On Error Resume Next
    Set r = Sheets("Sheet1").Range("O4,O6:O25").SpecialCells(xlCellTypeFormulas, 23)
    On Error GoTo 0
    If Not r Is Nothing Then
        For Each c In r
            flag = False
            If IsNumeric(c.Value) Then
                If c.Value <> 0 Then flag = True
            Else
                flag = True
            End If
            If flag Then s = s & c.Address(0, 0) & " "
        Next
        If Len(s) = 0 Then
            s = "範囲内の式の結果はすべて0でした"
        Else
            s = "以下のセルの値が0ではありませんでした" & vbLf & s
        End If
    Else
        s = "範囲内に式はありません"
    End If

    If MsgBox(s & vbLf & "保存しますか?", vbYesNo) = vbNo Then Cancel = True
    Set r = Nothing

End Sub

 ぶらっと立ち寄り

コメント返信:

[ 一覧(最新更新順) ]


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