Excel (VBA)

Excel VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 8.1 Pro : Excel 2007)
エラーのスキップ方法
投稿日時: 20/09/24 16:01:28
投稿者: FILETUBE

1つ教えて下さい。
 A,Bの2つのブックを集計して表示するVBAです。
 
  Dim vgkeA AS Long
   Dim vgkeB AS Long
 
   Set bk = Workbooks.Open(A.xlsx)
   Set ws = bk.Worksheets(1)
   Lstgyo = ws.Cells(Rows.Count, "A").End(xlUp).Row
   '*************
   For r = 2 To Lstgyo
       vgkeA = vgkeA + ws.Cells(r, 2)
   End If
   Next
   '*************
   bk.Close
   Set bk = Nothing
   Set ws = Nothing
 
   Set bk = Workbooks.Open(B.xlsx)
   Set ws = bk.Worksheets(1)
   Lstgyo = ws.Cells(Rows.Count, "A").End(xlUp).Row
   '*************
   For r = 2 To Lstgyo
       vgkeA = vgkeB + ws.Cells(r, 2)
   End If
   Next
   '*************
   bk.Close
   Set bk = Nothing
   Set ws = Nothing
 
   thisws.Cells(2,2) = vgkeA
   thisws.Cells(3,2) = vgkeB
 
  thisws画面表示は
  
   A合計 500
   B合計 700
 
 
  ボタンをクリックしたらA.xlsxとB.xlsxの全行の金額を集計し
  thisws.Cellsにセットします。
 
 集計項目に数字以外が入力されていた場合エラーになって異常終了してしまいますが
 A.xlsxの集計でエラーになった場合、異常終了するのではなく
 B.xlsxの集計にスキップするようにしたいのです。
 
  thisws画面表示は
  
   A合計 エラー
   B合計 700
 
 
 このように次のブックを集計するようにするには
 どのようにしたらよいでしょうか?
 
 宜しくお願いします。

回答
投稿日時: 20/09/24 16:46:07
投稿者: hatch315
メールを送信

例として、、、、
 
 'ブックA 集計
   vgkeA = 0: ErrvgkeA = ""
   For r = 2 To Lstgyo
 
       If WorksheetFunction.IsNumber(ws.Cells(r, 2)) = False Then
          ErrvgkeA = "ブックAエラー " & r & "行目"
          Exit For
       Else
          vgkeA = vgkeA + ws.Cells(r, 2)
       End If
   Next
 
   ブックB処理(ブックA 集計を参考に) 
 
  'ブックA 画面表示
   If ErrvgkeA <> "" Then
      thisws.Cells(2, 2) = ErrvgkeA
   Else
      thisws.Cells(2, 2) = vgkeA
   End If
 
  'ブックB 画面表示(ブックA 画面表示を参考に)
 

回答
投稿日時: 20/09/24 17:31:35
投稿者: Suzu

セルの値の合計が判れば良いのですよね?
 
その過程において、セルの値が「数値」と判断できない件数が判れば良い事になります。
 
であれば、
・RANGE(セル範囲).Count にて処理するセルの個数を求め
  必要に応じ COUNTBLANK関数に セル範囲を渡し その差を求め
 
・COUNT関数に対し、処理セルの範囲を渡し、数値(空白を含まない)のセルの数を求める
 
上記二つの「差」によって判断すれば良いでしょう。
 
COUNTBLANK関数も、COUNT関数も WorksheetFunctionを使えば VBA上でも使用できます。
WorkSheetFunction.COUNT(セル範囲)
WorkSheetFunction.COUNTBLANK(セル範囲)
 
 
同様に、
ループ処理をしなくとも
WorkSheetFunction.SUM(セル範囲) で。。。ねぇ。

回答
投稿日時: 20/09/24 19:04:53
投稿者: WinArrow
投稿者のウェブサイトに移動

ループしなくても
処理可能です。
 
以下のようにすれば、全セル個数。数値セル個数あ取得できます。
 
Dim RowMax As Long, ALLCOUNT As Long, NumericCOUNT As Long
 
    With Worksheets(1)
        RowMax = .Range("A" & .Rows.Count).End(xlUp).Row
        ALLCOUNT = WorksheetFunction.CountA(.Range("A2:A" & RowMax))
        NumericCOUNT = WorksheetFunction.Count(.Range("A2:A" & RowMax))
 
        Debug.Print WorksheetFunction.Sum(.Range("A2:A" & RowMax))
 
    End With
 
ワーうシート関数のSUM関数で合計も取得できます。
 

回答
投稿日時: 20/09/24 19:07:27
投稿者: mattuwan44

Option Explicit

Sub test()
    Dim wbk As Workbook
    Dim rngTarget As Range
    Dim rngResults As Range
    Dim n As Variant
    Dim a As Variant
    Dim ix As Long
    
    Set rngResults = ThisWorkbook.Worksheets(1).Range("B2:B3")
    
    For Each n In Array("A", "B")
        ix = ix + 1
        Set wbk = Workbooks.Open(n & ".xlsx")
        With wbk.Worksheets(1).UsedRange.Columns("B")
            Set rngTarget = Application.Range(.Cells(2), .Cells(.Cells.Count))
        End With
        
        With WorksheetFunction
            If .Count(rngTarget) <> .CountA(rngTarget) Then
                a = "エラー"
            Else
                a = .Sum(rngTarget)
            End If
        End With
        rngResults(ix).Value = a
        wbk.Close False
    Next
End Sub

 
こんな感じかなぁ。。。。
マクロなんか使わずに数式でやった方がよいような(列全体を合計してしまうようにする)気がしますが、
敢えてVBAの勉強で個々のセルをループして処理してみたいということでしょうか?

回答
投稿日時: 20/09/24 23:10:00
投稿者: WinArrow
投稿者のウェブサイトに移動

FILETUBEさんへ
 
掲示板へのコード掲示について・・
 
質問時に掲示したコードは、
直接、手入力していませんか?
 
このまま実行できない・・・コンパイルエラーが発生する箇所がいくつかあります。
 
掲示板へコードを掲示する場合は、コードペインから「コピペ」するよう「お願いします。
実際のコードと異なるコードで、質問されても、意味がありません。
 
今回の場合は、ともかくとして、今後、気を付けてください。

投稿日時: 20/09/25 08:04:32
投稿者: FILETUBE

 回答ありがとうございます。
 
どなたの回答も凄すぎで
 
ラベルを付けてスキップするような感じではできないのでしょうか?
 
またコードは実際のものから抜粋して投稿しました。
どうもすいません。
 
実際コピペで動くようなコードで投稿するように注意します。
今一度、テスト的なコードを作成して投稿し直します。

回答
投稿日時: 20/09/25 08:20:34
投稿者: WinArrow
投稿者のウェブサイトに移動

>ラベルを付けてスキップするような感じではできないのでしょうか?
 
コードの可読性を向上させるためにも
ラベルへのスキップ
はやめましょう・・・・・を推奨します。

投稿日時: 20/09/25 09:23:56
投稿者: FILETUBE

再度、動作可能なコードを投稿します。
 
G6をダブルクリックしたら次々とエクセルブックを集計し、sheet3に集計結果を表示する
VBAです。実際は集計するブックは20個あります。ブック毎の集計の途中でエラーになっても
次のブックの集計に進みたいのです。
 
下記が集計のコードになります(実際は日付の範囲のチェックが有ったり、集計する列はまちまちです)
どのような方法があるか教えて頂けないでしょうか。
宜しくお願いします。
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Not (Target.Row = 6 And Target.Column = 7) Then Exit Sub
 
   Dim mMessage As String
  'エラートラップ設定
   On Error GoTo ErrorHandler
    
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   '********************
   Dim Lstgyo As Long
   Dim r As Long
   
   Dim gkews As Worksheet
   Set gkews = ThisWorkbook.Worksheets(3)
      
   Dim bk As Workbook
   Dim ws As Worksheet
   '***********************************
   ' 処理1
   '***********************************
   Set bk = Workbooks.Open("C:\test\A.xlsx")
   Set ws = bk.Worksheets(1)
   Lstgyo = ws.Cells(Rows.Count, "A").End(xlUp).Row
   '*************
   For r = 2 To Lstgyo
       gkews.Cells(2, 3) = gkews.Cells(2, 3) + ws.Cells(r, 3)
   Next
   '*************
   bk.Close
   Set bk = Nothing
   Set ws = Nothing
   '***********************************
   ' 処理2
   '***********************************
   Set bk = Workbooks.Open("C:\test\B.xlsx")
   Set ws = bk.Worksheets(1)
   ws.AutoFilterMode = False
   Lstgyo = ws.Cells(Rows.Count, "A").End(xlUp).Row
   '*************
   For r = 2 To Lstgyo
       gkews.Cells(3, 3) = gkews.Cells(3, 3) + ws.Cells(r, 5)
   Next
   '*************
   bk.Close
   Set bk = Nothing
   Set ws = Nothing
   '***********************************
   ' 処理3
   '***********************************
   Set bk = Workbooks.Open("C:\test\C.xlsx")
   Set ws = bk.Worksheets(1)
   ws.AutoFilterMode = False
   Lstgyo = ws.Cells(Rows.Count, "A").End(xlUp).Row
   '*************
   For r = 2 To Lstgyo
       gkews.Cells(4, 3) = gkews.Cells(4, 3) + ws.Cells(r, 2)
   Next
   '*************
   bk.Close
   Set bk = Nothing
   Set ws = Nothing
   '********************
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
   mMessage = "抽出が完了しました。"
   MsgBox mMessage, vbInformation
 
ExitHandler:
  'オブジェクトの終了
 
   Exit Sub
 
ErrorHandler:
   'エラーメッセージの表示
   mMessage = "抽出が失敗しました。" & vbCrLf & vbCrLf
   mMessage = mMessage & "エラー内容:" & Err.Description
   MsgBox mMessage, vbExclamation
   GoTo ExitHandler
 
End Sub

投稿日時: 20/09/25 11:22:04
投稿者: FILETUBE

スキップの為のラベルを付けてみました。
 
ブックが存在しない時はデータ無し、
データに異常があった場合には異常終了をセットします。
 
処理2のOn Error GoTo ErrLabel22はスキップすますが
処理3のOn Error GoTo ErrLabel32ではスキップしなく
型が一致しませんのエラーで終了してしまいます。
 
一旦エラーをクリアしないといけないのでしょうか?
分かる方おられましたら宜しくお願いします。
 
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
   If Not (Target.Row = 6 And Target.Column = 7) Then Exit Sub
 
   Dim mMessage As String
  'エラートラップ設定
   On Error GoTo ErrorHandler
    
   Application.ScreenUpdating = False
   Application.DisplayAlerts = False
   '********************
   Dim Lstgyo As Long
   Dim r As Long
   
   Dim gkews As Worksheet
   Set gkews = ThisWorkbook.Worksheets(3)
   gkews.Cells(3, 3) = ""
   gkews.Cells(4, 3) = ""
   gkews.Cells(7, 3) = ""
   Dim bk As Workbook
   Dim ws As Worksheet
   '***********************************
   ' 処理1
   '***********************************
SYORI1:
   Application.StatusBar = "A 開始"
   On Error GoTo ErrLabel11
   Set bk = Workbooks.Open("C:\test\A.xlsx")
   Set ws = bk.Worksheets(1)
   ws.AutoFilterMode = False
   Lstgyo = ws.Cells(Rows.Count, "A").End(xlUp).Row
   '*************
   For r = 2 To Lstgyo
       On Error GoTo ErrLabel12
       gkews.Cells(2, 3) = gkews.Cells(2, 3) + ws.Cells(r, 3)
   Next
   '*************
   GoTo End1
ErrLabel11:
   gkews.Cells(2, 3) = "データ無し"
   GoTo SYORI2
ErrLabel12:
   MsgBox "Aでエラー発生", vbExclamation
   gkews.Cells(2, 3) = "異常終了"
End1:
   bk.Close
   Set bk = Nothing
   Set ws = Nothing
   '***********************************
   ' 処理2
   '***********************************
SYORI2:
   Application.StatusBar = "B 開始"
   On Error GoTo ErrLabel21
   Set bk = Workbooks.Open("C:\test\B.xlsx")
   Set ws = bk.Worksheets(1)
   ws.AutoFilterMode = False
   Lstgyo = ws.Cells(Rows.Count, "A").End(xlUp).Row
   '*************
   For r = 2 To Lstgyo
       On Error GoTo ErrLabel22
       gkews.Cells(3, 3) = gkews.Cells(3, 3) + ws.Cells(r, 5)
   Next
   '*************
   GoTo End2
ErrLabel21:
   gkews.Cells(3, 3) = "データ無し"
   GoTo SYORI3
ErrLabel22:
   MsgBox "Bでエラー発生", vbExclamation
   gkews.Cells(3, 3) = "異常終了"
End2:
   bk.Close
   Set bk = Nothing
   Set ws = Nothing
   '***********************************
   ' 処理3
   '***********************************
SYORI3:
   Application.StatusBar = "C 開始"
   On Error GoTo ErrLabel31
   Set bk = Workbooks.Open("C:\test\B.xlsx")
   Set ws = bk.Worksheets(1)
   ws.AutoFilterMode = False
   Lstgyo = ws.Cells(Rows.Count, "A").End(xlUp).Row
   '*************
   For r = 2 To Lstgyo
       On Error GoTo ErrLabel32
       gkews.Cells(7, 3) = gkews.Cells(7, 3) + ws.Cells(r, 5)
   Next
   '*************
   GoTo End3
ErrLabel31:
   gkews.Cells(7, 3) = "データ無し"
   GoTo ENDSYORI
ErrLabel32:
   MsgBox "Cでエラー発生", vbExclamation
   gkews.Cells(7, 3) = "異常終了"
End3:
   bk.Close
   Set bk = Nothing
   Set ws = Nothing
   
   '********************
ENDSYORI:
   Application.ScreenUpdating = True
   Application.DisplayAlerts = True
   mMessage = "抽出が完了しました。"
   MsgBox mMessage, vbInformation
 
ExitHandler:
  'オブジェクトの終了
 
   Exit Sub
 
ErrorHandler:
   'エラーメッセージの表示
   mMessage = "抽出が失敗しました。" & vbCrLf & vbCrLf
   mMessage = mMessage & "エラー内容:" & Err.Description
   MsgBox mMessage, vbExclamation
   GoTo ExitHandler
 
End Sub

回答
投稿日時: 20/09/25 13:50:08
投稿者: WinArrow
投稿者のウェブサイトに移動

基本的に
エラートラップは、予期しないような異常を発見する場合につくのが常套です。
エラートラップの使い方を間違えると、
正常な場合でもエラーと処理されてしまいます。
勿論、エラー対応処理後は、クリアしないと、以降、
正常な処理もエラーとなる可能性があります。
 
今回の場合は、
ファイルが存在しない
とk、
数値以外のセル
のように予期しているわけですから、
その通りのコードを記述することで、
わかりやすくなります。
エラートラップは、かえってコードの可動性を落とす形になります。
 
ラベルがあるから、ジャンプしたくなります。
重ねて言いますが、レベルを使わないコーディングをしましょう。
 
もう一つ、
今回の場合は、ワークシート関数で対応できます。
ループは、ワークシート関数に比べて、処理時間がかかります。
件数により、目立たないかもしれませんが・・・・

回答
投稿日時: 20/09/25 15:11:19
投稿者: Suzu

皆さんのコメントはエラートラップを使用せずに対処しましょうですが
コメントを理解できれば解決方法の一端は見えてくるはずです。
 

引用:
処理2のOn Error GoTo ErrLabel22はスキップすますが
処理3のOn Error GoTo ErrLabel32ではスキップしなく
型が一致しませんのエラーで終了してしまいます。
今回の直接の原因は、エラートラップ中に
Goto ステートメントで ラベル設置行に飛んでいます。
 
通常処理内であればそれでよいのですが、問題はエラートラップ中にある事です。
 
エラートラップ中に、
 Gotoで飛んで(この段階でエラー処理中の扱い)、更にエラーが発生しています。
 
Goto ではなく、Resume を使います。
 
セクションに分けてトラップが必要なら
 
Sub ErrSum()
On Error GoTo Err_
Dim i As Long

Sec1: i = 1: Err.Raise 1
Sec2: i = 2: Err.Raise 3
Sec3: i = 3: 'Err.Raise 7
 MsgBox "AA"

Ext_: Exit Sub

Err_: MsgBox Err.Number & vbCrLf & Err.Description
Select Case i
  Case 1: Resume Sec2
  Case 2: Resume Sec3
  Case Else: End Select
End Sub

 
こんな形になるでしょう。
(Err.Raise 7 の部分 コメントアウトを外し 処理フロー確認ください)
 
 
何度も言われていますが、エラートラップは、予想外の事に対応する為の処理です。
予想がついている事なのであれば、それに対する処置を入れる方が良いと思います。

回答
投稿日時: 20/09/25 15:47:45
投稿者: WinArrow
投稿者のウェブサイトに移動

>ループは、ワークシート関数に比べて、処理時間がかかります。
 
この部分の説明を追加します。
単純にループ処理が悪いということでは会いません。
 
今回の場合、ループの中で、セルをアクセスしています。
セルをアクセスする場合、
個々のセルをアクセスする方が、
セルをまとめてアクセスするより、処理時間が掛かるということです。
 
今回の場合、数値以外の阿知賀入っているセルを取得するのではないので
セルをまとめてアクセスしたほうがはやいです。

投稿日時: 20/09/25 16:13:40
投稿者: FILETUBE

 何度も回答ありがとうございました。
 
確かにおっしゃる通りだと思います。
ワークシート関数を勉強したいと思います。
 
ご教授ありがとうございました。
また宜しくお願いします。