☰

Excel VBA - 跳过行/转到命令的代码

tag-icon • tag-icon microsoft-excel microsoft-excel-2010 vba pivot-table
Excel VBA - 跳过行/转到命令的代码

我已经在 Excel 中编写了代码，用于从数据透视表中获取数据并将其插入图表中，但直接链接到表格的数据透视图无法提供我想要的可操作性。我之所以费尽心思编写如此“复杂”的代码，是因为对于每个工厂和测试信息组合，我都需要将其作为图表中的单独条目。

因此，此代码的要点是检查每个工厂和测试信息组合（嵌套的 for 命令），然后将数据插入图表。我的用户不会更改 x 和 y 的列位置，因此偏移量可以正常工作。

我的问题是，如果工厂/测试信息组合不存在，它无论如何都会将其输入到图表中。当我尝试使用 goto 命令并使用错误句柄将其发送到下一个 PI2 时，它不起作用（可能是因为嵌套的 if 命令）。我一直在寻找可以将我的代码发送到代码中的特定行（即图形命令之后）的命令，但没有任何运气……

有人知道在发生错误时跳到特定行的方法吗？

我已经添加了在下一个 PI2 处恢复的命令集，其中我说在发生错误时转到 errhandler，然后从 errhandler 转到下一次迭代，但是当我运行代码并收到错误时，它不会通过这条路线，而是停在“相交”线上。

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

您可以在不goto使用 VBA 的情况下处理错误，如下所示：

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非常有帮助。

原来我尝试使用两个 goto 命令，第一个 goto 是错误处理程序，然后 goto 是下一个迭代。我需要做的是将第二个 goto 更改为恢复。

感谢大家的帮助，上述代码运行完美！

相关内容