☰

Excel VBA - 行をスキップするコード / goto コマンド

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 vba pivot-table
Excel VBA - 行をスキップするコード / goto コマンド

ピボット テーブルからデータを取得してグラフに挿入するコードを Excel に組み込みましたが、テーブルに直接リンクされたピボット グラフでは、必要な操作性が得られません。このような「複雑な」コードを作成する手間をかけた理由は、プラントとテスト情報の組み合わせごとに、グラフに別々に入力する必要があるためです。

したがって、このコードの主なポイントは、各プラントとテスト情報の組み合わせ (ネストされた for コマンド) を調べて、データをチャートに挿入することです。ユーザーは x と y の列の位置を変更しないので、オフセットは正常に機能します。

私の問題は、プラント/テスト情報の組み合わせが存在しない場合は、とにかくそれをチャートに入力することです。goto コマンドを使用して、エラー ハンドルを使用して Next PI2 に送信しようとすると、機能しません (おそらく、ネストされた if コマンドのためです)。コード内の特定の行 (つまり、グラフ コマンドの直後) にコードを送信できるコマンドを探していましたが、見つかりませんでした...

エラーが発生した場合に特定の行にスキップする方法を知っている人はいますか?

次の PI2 で再開するためのコマンド セットを追加しました。ここでは、エラー発生時に errhandler に移動し、errhandler から次の反復に進むように指定していますが、コードを実行してエラーが発生すると、このルートを経由せず、代わりに「intersect」行で停止します。

Sub CreatePivotChart()

 Dim PF1 As PivotField
 Dim PI1 As PivotItem
 Dim PI2 As PivotItem
 Dim PF2 As PivotField
 Dim chartcount As Integer
 Dim pt As PivotTable
 Set pt = Worksheets("Pivot Table").PivotTables("PivotTable")

'set up pivot field locations 1 - plant and unit , 2 - test conditions

 Set PF1 = Worksheets("PivotTable").PivotTables("PivotTable").PivotFields("Plant")

 Set PF2 = Worksheets("Pivot Table").PivotTables("PivotTable").PivotFields("Test Info")

 'clear the chart from previous run
  chartcount = 0
  Sheets("Pivot Table Graph").ChartObjects("Chart 1").Chart.ChartArea.ClearContents

  On Error GoTo ErrHandler

 'find each visible unit
  For Each PI1 In PF1.PivotItems

  If PI1.Visible = True Then
     Unit = PI1.Name

     For Each PI2 In PF2.PivotItems

     'for each unit and test condition find the information at their intersection
       If PI2.Visible = True Then
       TC = PI2.Name


    'find the information that corresponds to each unit/test condition combination
    Intersect(pt.PivotFields("Plant").PivotItems(Unit).DataRange.EntireRow, pt.PivotFields("Test Info").PivotItems(TC).DataRange).Select
    Selection.Offset(-1, 0).Select
    ForXRanges = "='Pivot Table'!" & Selection.Address
    Selection.Offset(0, 1).Select
    ForYRanges = "='Pivot Table'!" & Selection.Address
    ForRangesName = Unit & "_" & TC

    'for each combination create a new series on the chart
    chartcount = chartcount + 1
    Sheets("Pivot Table Graph").ChartObjects("Chart 1").Activate
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(chartcount).Name = ForRangesName
    ActiveChart.SeriesCollection(chartcount).XValues = ForXRanges
    ActiveChart.SeriesCollection(chartcount).Values = ForYRanges

End If

NextIteration:
Next PI2

End If
Next PI1

Exit Sub

ErrHandler:
Resume NextIteration:

End Sub

答え1

より良い方法は、if ステートメントを使用してデータをテストし、データが有効であることを確認することです。有効でない場合は、エラーが発生する可能性のあるコード ブロックを続行しないでください。

あなたの例では、これはうまくいくかもしれません...これを変更してください:

'find the information that corresponds to each unit/test condition combination
Intersect(pt.PivotFields("Plant").PivotItems(Unit).DataRange.EntireRow, pt.PivotFields("Test Info").PivotItems(TC).DataRange).Select
Selection.Offset(-1, 0).Select
ForXRanges = "='Pivot Table'!" & Selection.Address
Selection.Offset(0, 1).Select
ForYRanges = "='Pivot Table'!" & Selection.Address
ForRangesName = Unit & "_" & TC

'for each combination create a new series on the chart
chartcount = chartcount + 1
Sheets("Pivot Table Graph").ChartObjects("Chart 1").Activate
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(chartcount).Name = ForRangesName
ActiveChart.SeriesCollection(chartcount).XValues = ForXRanges
ActiveChart.SeriesCollection(chartcount).Values = ForYRanges

これに対して:

'find the information that corresponds to each unit/test condition combination
Set isect = Application.Intersect(pt.PivotFields("Plant").PivotItems(Unit).DataRange.EntireRow, pt.PivotFields("Test Info").PivotItems(TC).DataRange)

If isect Is Nothing Then 
    'Msgbox "Ranges do not intersect"
Else
    isect.Select 

    Selection.Offset(-1, 0).Select
    ForXRanges = "='Pivot Table'!" & Selection.Address
    Selection.Offset(0, 1).Select
    ForYRanges = "='Pivot Table'!" & Selection.Address
    ForRangesName = Unit & "_" & TC

    'for each combination create a new series on the chart
    chartcount = chartcount + 1
    Sheets("Pivot Table Graph").ChartObjects("Chart 1").Activate
    ActiveChart.SeriesCollection.NewSeries
    ActiveChart.SeriesCollection(chartcount).Name = ForRangesName
    ActiveChart.SeriesCollection(chartcount).XValues = ForXRanges
    ActiveChart.SeriesCollection(chartcount).Values = ForYRanges
End If

ワークブックを持っていないのでこれをテストすることはできませんが、うまくいかない場合はアプローチを示す必要があります。

答え2

gotoVBA で次のようにエラーを処理できます。

Sub ErrorHandling()
Dim A, d

On Error Resume Next    
REM Line that throws an error
A = A / 0
REM Store details about your error before it gets cleared
d = Err.Description

On Error GoTo 0

REM You see and can handle your error message here
MsgBox d  
End Sub

On Error Resume Nextエラーのスローを無効にする

On Error GoTo 0エラーをスローしてErrオブジェクトをクリアします

答え3

私は古い投稿などを読み続けることで、自分自身の疑問に答えることに成功しました。http://www.cpearson.com/excel/errorhandling.htm非常に役立ちます。

結局、2 つの goto コマンドを使用しようとしていたことがわかりました。最初はエラー ハンドラに移動し、次に次の反復処理に移動します。必要なのは、2 番目の goto を再開に変更することでした。

皆さんのご協力に感謝します。上記のコードは完璧に実行されました!

関連情報