VB2005からExcelのセルの値参照について

Question

PC環境

・Microsoft Visual Basic 2005 Professional Edition SP1

・Excel2003 SP2

・WindowsXP Pro SP2

 

式が入力されているセルの値を得るため、RangeオブジェクトのValueプロパティ を使用しています。

 

式の結果がエラー値(0除算の #DIV/0! など)のとき、Valueプロパティで得た値が

マイナスの数値( #DIV/0! のときは -2146826281 )になってしまう現象が起きてしまい困っております。

私のPCだけの現象ではなく、他の同環境のPCでも同じ結果です。

セルの値がVB2005側でエラー値かどうか判別する方法はありませんか？

 

 

 

以下現象が発生するサンプルコード

参照設定で Microsoft Excel 11.0 Object Library を参照しています。

コード ブロック

        Dim l_app As Excel.Application
        Dim l_bk As Excel.Workbook
        Dim l_sht As Excel.Worksheet
        Dim l_cellvalue As Object

        l_app = CreateObject("Excel.Application")
        l_app.Visible = True

        l_bk = l_app.Workbooks.Add()

        l_sht = l_bk.ActiveSheet

        l_sht.Range("A1").Formula = "=A2/0"

        l_cellvalue = l_sht.Range("A1").Value

        MsgBox(l_cellvalue, MsgBoxStyle.MsgBoxSetForeground)

        l_sht = Nothing
        l_bk = Nothing
        l_app = Nothing

 

 

 

 

 

Answer 1

zakugufudom さんからの引用

セルの値がVB2005側でエラー値かどうか判別する方法はありませんか？

Excel.Range のインスタンスから Errors プロパティ (だったかな?) を参照してみてもダメでしょうか?

以下現象が発生するサンプルコード 参照設定で Microsoft Excel 11.0 Object Library を参照しています。

サンプル コードとはいえ、このコードはまずいですね。
COM の参照カウントを考慮していません。
ご存知であって敢えて省略していることも考えましたが、最後の参照の解放こそ蛇足なのでやはりご存知ないと思って書きました。

Answer 2

じゃんぬねっと さんご回答ありがとうございます。

 

じゃんぬねっと さんからの引用

Excel.Range のインスタンスから Errors プロパティ (だったかな?) を参照してみてもダメでしょうか?

 

Errorsプロパティで判別できました。ありがとうございます。

 

ただ、今回の件はさらに続きがありまして・・・

 

サンプルコードでは1つのセルの値を得るものですが、最終的にやりたいことは複数セルの値を得ることです。

1つ1つのセルを参照すればよいのはわかりますが、セル範囲が "A1：D100" とかですとVBからExcelのセルへの参照が400回になります。

 

VB6.0とExcelの組み合わせでは、Excelへのアクセスを繰り返すと処理に時間がかかってしまい

 

l_cellvalue = l_sht.Range("A1:D100").value

 

と配列で受け取って、配列の1要素ずつIsError関数で判別していました。

 

VB2005でも同様に配列で行おうとしているところです。

 

Errorsプロパティで1セルは判別可能であることは確認できたのですが、

Errorsプロパティで複数セル対象にして参照しようとするとエラーになるようです。

 

Excel VBAで次の様なコードを実行すると

l_errvalue = Sheet1.Range("A1:B7").Errors.Item(Excel.XlErrorChecks.xlEvaluateToError).Value

実行時エラー '1004':

アプリケーション定義またはオブジェクト定義のエラーです。

 

とエラーが発生してしまいます。Rangeの範囲を A1 にすると動作します。

 

よい対応策がないものかと。

 

 

サンプル コードとはいえ、このコードはまずいですね。 COM の参照カウントを考慮していません。 ご存知であって敢えて省略していることも考えましたが、最後の参照の解放こそ蛇足なのでやはりご存知ないと思って書きました。

 

ご指摘ありがとうございます。

Nothingを入れればよいと思ってました。

 

修正したコードを載せます。たぶん大丈夫だと思うんですが。。。

 

コード ブロック

        Dim l_app As Excel.Application
        Dim l_bks As Excel.Workbooks
        Dim l_bk As Excel.Workbook
        Dim l_sht As Excel.Worksheet
        Dim l_range As Excel.Range
        Dim l_cellvalue As Object

        l_app = CreateObject("Excel.Application")
        l_app.Visible = True

        l_bks = l_app.Workbooks
        l_bk = l_bks.Add()

        l_sht = l_bk.ActiveSheet
        l_range = l_sht.Range("A1")

        l_range.Formula = "=A2/0"

        l_cellvalue = l_range.Value

        MsgBox(l_cellvalue, MsgBoxStyle.MsgBoxSetForeground)

        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_range)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_sht)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_bk)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_bks)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_app)

 

 

Answer 3

zakugufudom さんからの引用

Errorsプロパティで1セルは判別可能であることは確認できたのですが、 Errorsプロパティで複数セル対象にして参照しようとするとエラーになるようです。   Excel VBAで次の様なコードを実行すると l_errvalue = Sheet1.Range("A1:B7").Errors.Item(Excel.XlErrorChecks.xlEvaluateToError).Value 実行時エラー '1004': アプリケーション定義またはオブジェクト定義のエラーです。   とエラーが発生してしまいます。Rangeの範囲を A1 にすると動作します。

Excel VBA で、ですか?

ちょっと背景がわかりませんが、どの時点で定義のエラーになっているか、
それを理解していらっしゃるかがポイントになります。

修正したコードを載せます。たぶん大丈夫だと思うんですが。。。

ミニマム コードとしては問題ないと思います。

Answer 4

じゃんぬねっと さん、お付き合いいただきありがとうございます。

 

VBからExcelの話になってしまいごめんなさい。

 

じゃんぬねっと さんからの引用

Excel VBA で、ですか? ちょっと背景がわかりませんが、どの時点で定義のエラーになっているか、 それを理解していらっしゃるかがポイントになります。

 

Excel VBAのコードです。Excel マクロのコードと言ったほうが伝わりますか？

VB2005のコードではありません。コード自体も省略しすぎました。申し訳ありません。

 

Excelの自動マクロで記述した作業とかが主ですが、Excelを操作する部分はExcelVBAのコードで書いてみて、

動作したらVB2005へそのコードを転記しています。変数の宣言やset とかはもちろん編集します。

 

A1セルのみの場合のコードはExcelで次のVBAコードを実行すると動作します。A1セルがエラー値であればTrueが表示されます。

コード ブロック

Sub test()
    Dim l_ws As Worksheet
    Dim l_range As Range
    Dim l_errs As Errors
    Dim l_err As Error
    Dim l_errvalue As Boolean

 

    Set l_ws = Worksheets("Sheet1")
    Set l_range = l_ws.Range("A1")
    Set l_errs = l_range.Errors
    Set l_err = l_errs.Item(xlEvaluateToError)
   
    l_errvalue = l_err.Value
   
    MsgBox l_errvalue
    
    Set l_err = Nothing
    Set l_errs = Nothing
    Set l_range = Nothing
    Set l_ws = Nothing

End Sub

 

 

 

複数セルの情報を1回のアクセスで得ようと思い次のVBAコードを実行してみました。

Errorsプロパティの参照部分でエラーが表示されます。

 

ExcelのErrorsオブジェクトのヘルプを見ると "セル範囲のさまざまなエラーを表します。" とあるので

複数セルのエラー情報を配列で得ることができるのかな？と思ったんですが。

 

コード ブロック

Sub test2()
    Dim l_ws As Worksheet
    Dim l_range As Range
    Dim l_errs As Variant
    Dim l_err As Variant
    Dim l_errvalue As Variant

 

    Set l_ws = Worksheets("Sheet1")
    Set l_range = l_ws.Range("A1:B7")
    Set l_errs = l_range.Errors
    Set l_err = l_errs.Item(xlEvaluateToError)
   
    l_errvalue = l_err.Value
   
    MsgBox l_errvalue(1, 1)
   
   
    Set l_err = Nothing
    Set l_errs = Nothing
    Set l_range = Nothing
    Set l_ws = Nothing

End Sub

 

 

ふと思ったんですが、このコードでErrorsプロパティで配列で受け取れたとしても次のItemプロパティで多分エラーが出ますね。

仮にl_errs(1,1).Item(xlEvaluateToError) の様にして参照できても、VB2005で同様のコードを実行すると

セル数分のExcelへの参照が発生してしまいますね。このコードは考え方がそもそも間違っている気がしてきました。

 

目的はあるセル範囲内の各セルのエラー値をセル数分の参照を行わずに得ることです。

 

エラー値がなければセル値は Range("A1:B7").Value で配列で1度に取得できるのですが。

VB6.0ではValueプロパティでエラー情報を得ることができたのに・・・

 

 

ミニマム コードとしては問題ないと思います。

 

確認ありがとうございます。勉強になりました。

Answer 5

zakugufudom さん、こんにちは。

Errors プロパティに限らずですが、複数のセルを選択した状態での参照で HRESULT からの例外になってしまうことがあります。
この例外が返された場合の多くは制限だと思って頂いて良いです。

おそらくですが、調べたいセル範囲を持つ Excel.Range から Select メソッドを実行し、Excel.Application インターフェイスの ActiveCell プロパティからであれば、Errors プロパティは参照できると思います。
ただし結果が思ったとおりの値でないかもしれません。

Answer 6

返事が遅れまして申し訳ありません。

 

じゃんぬねっと さんからの引用

おそらくですが、調べたいセル範囲を持つ Excel.Range から Select メソッドを実行し、Excel.Application インターフェイスの ActiveCell プロパティからであれば、Errors プロパティは参照できると思います。 ただし結果が思ったとおりの値でないかもしれません。

 

確かにActiveCell プロパティを使用すればErrors プロパティを使用できますが、

ActiveCell プロパティは現在Activeになっているセル(1つのセル)になりますので

複数セルのエラー情報を得ることはできないと思います。

 

今回の対応策として、Range(＊).Value で得られる値は、エラー値の場合それぞれのエラー値によって

特定のマイナスの数値(Integer)が返ってくる様です。その数値が返ってきたセルについては

Errorプロパティでエラー値なのか、本当の数値なのか判別することで対応しようかと思います。

 

できれば一括で複数セルのエラー情報が得られれば楽なんですけど。

 

じゃんぬねっと さん、ありがとうございました。

Answer 7

一括で確認するにはメソッドを書くほかなさそうです。
Excel.Range を引数に持ち、Errors の値を戻り値で返すようなメソッドを書くという方法です。

パフォーマンスを気にされているようでしたが、私が確認したところそれほどパフォーマンス ダウンするわけでもなさそうです。
ただし、Worksheet の状態を変更する場合はかなりパフォーマンス ダウンするようなのでご注意ください。

Answer 8

 じゃんぬねっと さん、こんにちは。

 

パフォーマンスについて実験してみました。実行環境によって結果は異なってきますので参考までに。

 

テスト環境

Win Xp SP2

Excel 2003 SP2

VB2005 SP1

CPU CeleronD 3Ghz

メモリ 512MB

 

 

テスト1：6000セルを1セルずつ参照し、errorプロパティでのエラー情報参照とvalueプロパティでの値参照

  結果 約40秒

 

テスト2：6000セルを1セルずつ参照し、valueプロパティでの値参照

  結果 約20秒

 

テスト3：6000セルのそれぞれの値をvalueプロパティで配列で受け取る

  結果 約1秒

 

 

このテストは1シートあたり6000セルを対象にしましたが、私が実際やろうとしているのは10シート分(6000×10 セル分)の読み込みです。単純計算で10倍の時間がかかることになります。

 

6000セルすべてのerrorプロパティを調べるのではなく、エラーと疑われるセルのみerrorプロパティで調べ、処理時間増加を極力抑える方向で対応することにしました。

 

以下、今回使用したテストコードです。Excelを実行する前に起動しておいてください。

コード ブロック

    Sub test1()
        Dim l_app As Excel.Application
        Dim l_bks As Excel.Workbooks
        Dim l_bk As Excel.Workbook
        Dim l_sht As Excel.Worksheet
        Dim l_range As Excel.Range
        Dim l_cells As Excel.Range
        Dim l_cell As Excel.Range
        Dim l_cellvalue As Object
        Dim l_cellvalue2 As Object
        Dim l_r, l_c As Integer
        Dim l_lr, l_ur, l_lc, l_uc As Integer
        Dim l_time As Date

        Dim l_errors As Excel.Errors
        Dim l_error As Excel.Error

 

        l_app = GetObject(, "Excel.Application")
        l_app.Visible = True

        l_bks = l_app.Workbooks
        l_bk = l_bks.Add()
        l_sht = l_bk.ActiveSheet
        l_range = l_sht.Range("A1:C2000")
        l_cells = l_range.Cells

 

        l_time = TimeOfDay

 

        l_lr = 1
        l_ur = 2000
        l_lc = 1
        l_uc = 3

 

        For l_r = l_lr To l_ur
            For l_c = l_lc To l_uc

 

                l_cell = l_cells(l_r, l_c)

 

                l_errors = l_cell.Errors
                l_error = l_errors.Item(Excel.XlErrorChecks.xlEvaluateToError)

 

                l_cellvalue = l_error.Value

 

                System.Runtime.InteropServices.Marshal.ReleaseComObject(l_error)
                System.Runtime.InteropServices.Marshal.ReleaseComObject(l_errors)

 

                l_cellvalue2 = l_cell.Value

 

                System.Runtime.InteropServices.Marshal.ReleaseComObject(l_cell)

            Next l_c
        Next l_r

        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_cells)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_range)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_sht)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_bk)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_bks)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_app)

 

        MsgBox(l_time.ToString("hh:mm:ss") & " → " & TimeOfDay.ToString("hh:mm:ss"))
    End Sub

 

 

 

 

コード ブロック

    Sub test2()
        Dim l_app As Excel.Application
        Dim l_bks As Excel.Workbooks
        Dim l_bk As Excel.Workbook
        Dim l_sht As Excel.Worksheet
        Dim l_range As Excel.Range
        Dim l_cells As Excel.Range
        Dim l_cell As Excel.Range
        Dim l_cellvalue2 As Object
        Dim l_r, l_c As Integer
        Dim l_lr, l_ur, l_lc, l_uc As Integer
        Dim l_time As Date

 

        l_app = GetObject(, "Excel.Application")
        l_app.Visible = True

        l_bks = l_app.Workbooks
        l_bk = l_bks.Add()
        l_sht = l_bk.ActiveSheet
        l_range = l_sht.Range("A1:C2000")
        l_cells = l_range.Cells

 

        l_time = TimeOfDay

 

        l_lr = 1
        l_ur = 2000
        l_lc = 1
        l_uc = 3

        For l_r = l_lr To l_ur
            For l_c = l_lc To l_uc

 

                l_cell = l_cells(l_r, l_c)

 

                l_cellvalue2 = l_cell.Value

 

                System.Runtime.InteropServices.Marshal.ReleaseComObject(l_cell)

            Next l_c
        Next l_r

        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_cells)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_range)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_sht)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_bk)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_bks)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_app)

 

        MsgBox(l_time.ToString("hh:mm:ss") & " → " & TimeOfDay.ToString("hh:mm:ss"))
    End Sub

 

 

 

コード ブロック

   Sub test3()
        Dim l_app As Excel.Application
        Dim l_bks As Excel.Workbooks
        Dim l_bk As Excel.Workbook
        Dim l_sht As Excel.Worksheet
        Dim l_range As Excel.Range
        Dim l_cellvalue As Object
        Dim l_cellvalue2 As Object
        Dim l_r, l_c As Integer
        Dim l_lr, l_ur, l_lc, l_uc As Integer
        Dim l_time As Date

 

        l_app = GetObject(, "Excel.Application")
        l_app.Visible = True

        l_bks = l_app.Workbooks
        l_bk = l_bks.Add()
        l_sht = l_bk.ActiveSheet
        l_range = l_sht.Range("A1:C2000")

        l_time = TimeOfDay

 

        l_cellvalue = l_range.Value

        l_lr = 1
        l_ur = 2000
        l_lc = 1
        l_uc = 3

 

        For l_r = l_lr To l_ur
            For l_c = l_lc To l_uc

                l_cellvalue2 = l_cellvalue(l_r, l_c)

            Next l_c
        Next l_r

        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_range)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_sht)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_bk)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_bks)
        System.Runtime.InteropServices.Marshal.ReleaseComObject(l_app)

 

        MsgBox(l_time.ToString("hh:mm:ss") & " → " & TimeOfDay.ToString("hh:mm:ss"))
    End Sub

 

 

Answer 9

ご報告ありがとうございます。

そうですか、ずいぶんと違うものなのですね。

私の環境では差異があまり出なかったため内部的には似たようなものだと思っていたのですが...

ありがとうございます。