Question

我在Excel中有一个带有三个数据透视图的电子表格。我编写了执行以下操作的VBA代码：

' Copies sheets 1-4
ThisWorkbook.Worksheets(Array("1", "2", "3", "4")).Copy

'Transforms each new sheet data in values only.
For Each iSheet In ActiveWorkbook.Sheets
    iSheet.Activate
    iSheet.UsedRange.Copy
    iSheet.UsedRange.PasteSpecial xlPasteValuesAndNumberFormats
    iSheet.Range("A1").Select
Next iSheet

' After pasting, deletes the contents of the cells but keeps the graphs
' in spread sheet 4
ActiveWorkbook.Sheets("4").Columns("J:AB").Clear

此代码在调试模式（F8）中的运行方式与通过按F5或通过Excel中的按钮运行的方式不同。在调试模式下，将数据透视表粘贴为值时，它将所有系列信息保留在数据透视图中。当它不间断运行时，它会丢失数据透视图信息，因此，例如，系列名称更改为默认的“系列1”，x值从特定的日期值更改为jan-00，x轴标签的格式更改为文本，等等。。我不知道为什么。在另一个非常类似的问题中，有人指出，未激活目标工作表时，PasteSpecial的行为有所不同，这就是为什么我添加了iSheet.Activate的原因。这种作用上的差异也可能是数据透视表的“清除”方法的结果。

我尝试在代码的不同步骤中添加“激活”，但无济于事。

Answer 1

我假设您只想在活动工作簿的每个工作表上保留值，就是这样：

' Copies sheets 1-4
ThisWorkbook.Worksheets(Array("1", "2", "3", "4")).Copy

'Transforms each new sheet data in values only.
For Each iSheet In ActiveWorkbook.Sheets
    iSheet.UsedRange.Values = iSheet.UsedRange.Values
Next iSheet

认为复制纸张的第一行没有意义。

Answer 2

好像不在乎您是否真的保留数据透视表的值。在我刚刚运行的示例中，我在G2：L19中有一个数据透视表。我执行了这行代码，删除了包含数据透视表的列，并保留了数据透视图，绘制了相同的数据，但是现在将数据硬编码到图表中。

ActiveSheet.Range("G:L").Delete

如果您确实想保留值和数字格式，而不要保留数据透视表本身，则此代码以F5或F8模式运行，将数据保留在数据透视表所在的位置，并将数据保留在图表中很难编码（从数据透视表取消链接）。

Sub UnpivotTable()
  With ActiveSheet.Range("G2:L19")
    .Copy
    .PasteSpecial xlPasteValuesAndNumberFormats
  End With
End Sub

您要保留图表到数据的链接吗？存储系列公式，撤消数据透视表，然后重新应用系列公式：

Sub UnpivotTableKeepChartLinks()
  Dim MyChart As Chart
  Set MyChart = ActiveSheet.ChartObjects("Chart 1").Chart
  Dim vSrsFmlas As Variant
  ReDim vSrsFmlas(1 To MyChart.SeriesCollection.Count)
  Dim iSrs As Long
  For iSrs = 1 To MyChart.SeriesCollection.Count
    vSrsFmlas(iSrs) = MyChart.SeriesCollection(iSrs).Formula
  Next
  With ActiveSheet.Range("G2:L19")
    .Copy
    .PasteSpecial xlPasteValuesAndNumberFormats
  End With
  For iSrs = 1 To MyChart.SeriesCollection.Count
    MyChart.SeriesCollection(iSrs).Formula = vSrsFmlas(iSrs)
  Next
End Sub

VBA复制粘贴在调试模式下运行不同

2 个答案: