Question

我在excel的VBA中的宏中出现迷你图问题。在调试逐步模式下，它工作正常，但是在运行时，迷你图完全错误，它们位于相同的区域，但似乎涵盖了其他数据。我不知道这可能是什么问题。

这是代码： *复制的数据透视表是之前定义的（私有）变量

Sub DashboardMarket()

Dim ws As Worksheet
Dim lastColD As Integer, lastColD2 As Integer, lastRowD As Integer

Dim ptDM1 As PivotTable, ptDM2 As PivotTable, ptDM3 As PivotTable, ptDM4 As 
PivotTable

Application.DisplayAlerts = False
With ThisWorkbook
    If DoesSheetExist("Dashboard Market") = True Then
        If MsgBox("Do you wish to update existing Market Dashboard?", vbYesNo, "Confirm") = vbYes Then
        .Sheets("Dashboard Market").Delete
        .Sheets.Add(Before:=Sheets("data")).Name = "Dashboard Market"
        Else: Exit Sub
        End If
    Else: .Sheets.Add(Before:=Sheets("data")).Name = "Dashboard Market"
    End If
End With
Application.DisplayAlerts = True

Set ws = ThisWorkbook.Sheets("Dashboard Market")
ws.Select

scdpt4.TableRange2.Cells.Resize(, scdpt4.TableRange2.Columns.Count + 2).Copy         
Destination:=ws.Cells(5, 2)
lastColD = 1 + scdpt4.TableRange2.Columns.Count + 2
lastRowD = 4 + scdpt4.TableRange2.Rows.Count
Set ptDM1 = ws.Cells(5, 2).PivotTable

    'create sparklines
    Range(Cells(ptDM1.DataBodyRange.Cells(1, 1).Row, lastColD), Cells(lastRowD, lastColD)).SparklineGroups.Add Type:=xlSparkLine, _
    SourceData:=Range(ptDM1.DataBodyRange.Cells(1, 2), ws.Cells(lastRowD, lastColD - 2)).Address
    'format sparklines
    With Range(Cells(ptDM1.DataBodyRange.Cells(1, 1).Row, lastColD), Cells(lastRowD, lastColD)).SparklineGroups.Item(1)
        .LineWeight = 1.1
        .Points.Markers.Visible = True
        .Points.Markers.Color.ColorIndex = 3
        .SeriesColor.ColorIndex = 32
        .SeriesColor.TintAndShade = 0
    End With

scdpt5.TableRange2.Cells.Resize(, scdpt5.TableRange2.Columns.Count + 2).Copy 
Destination:=ws.Cells(lastRowD + 2, 2)

Set ptDM2 = ws.Cells(lastRowD + 2, 2).PivotTable

lastRowD = 1 + lastRowD + scdpt5.TableRange2.Rows.Count

    'create sparklines
    Range(Cells(ptDM2.DataBodyRange.Cells(1, 1).Row, lastColD), Cells(lastRowD, lastColD)).SparklineGroups.Add Type:=xlSparkLine, _
    SourceData:=Range(ptDM2.DataBodyRange.Cells(1, 2), Cells(lastRowD, lastColD - 2)).Address
    'format sparklines
    With Range(Cells(ptDM2.DataBodyRange.Cells(1, 1).Row, lastColD), ws.Cells(lastRowD, lastColD)).SparklineGroups.Item(1)
        .LineWeight = 1.1
        .Points.Markers.Visible = True
        .Points.Markers.Color.ColorIndex = 3
        .SeriesColor.ColorIndex = 32
        .SeriesColor.TintAndShade = 0
    End With

pt1.TableRange2.Copy Destination:=ws.Cells(5, lastColD + 2)
lastRowD = 4 + pt1.TableRange2.Rows.Count
pt2.TableRange2.Copy Destination:=ws.Cells(lastRowD + 2, lastColD + 2)
lastRowD = 1 + lastRowD + pt2.TableRange2.Rows.Count
pt3.TableRange2.Copy Destination:=ws.Cells(lastRowD + 2, lastColD + 2)
lastRowD = 1 + lastRowD + pt3.TableRange2.Rows.Count
pt4.TableRange2.Copy Destination:=ws.Cells(lastRowD + 2, lastColD + 2)
lastRowD = 1 + lastRowD + pt4.TableRange2.Rows.Count
pt5.TableRange2.Copy Destination:=ws.Cells(lastRowD + 2, lastColD + 2)
lastRowD = 1 + lastRowD + pt5.TableRange2.Rows.Count

lastColD = 1 + lastColD + pt1.TableRange2.Columns.Count

With ws.Range(Cells(3, 2), Cells(3, lastColD))
.MergeCells = True
.Value = "COMMUNICATED DISCOUNTS"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Bold = True
.Interior.ColorIndex = 16
.Font.ColorIndex = 2
.Font.Size = 16
End With

pp_pt1.TableRange2.Cells.Resize(, pp_pt1.TableRange2.Columns.Count + 2).Copy Destination:=ws.Cells(5, lastColD + 2)
lastRowD = 4 + pp_pt1.TableRange2.Rows.Count
lastColD2 = 1 + lastColD + pp_pt1.TableRange2.Columns.Count + 2

Set ptDM3 = ws.Cells(5, lastColD + 2).PivotTable

    'create sparklines
    Range(Cells(ptDM3.DataBodyRange.Cells(1, 1).Row, lastColD2), Cells(lastRowD, lastColD2)).SparklineGroups.Add Type:=xlSparkLine, _
    SourceData:=Range(ptDM3.DataBodyRange.Cells(1, 2), ws.Cells(lastRowD, lastColD2 - 2)).Address
    'format sparklines
    With Range(Cells(ptDM3.DataBodyRange.Cells(1, 1).Row, lastColD2), Cells(lastRowD, lastColD2)).SparklineGroups.Item(1)
        .LineWeight = 1.1
        .Points.Markers.Visible = True
        .Points.Markers.Color.ColorIndex = 3
        .SeriesColor.ColorIndex = 32
        .SeriesColor.TintAndShade = 0
    End With

pp_pt2.TableRange2.Cells.Resize(, pp_pt2.TableRange2.Columns.Count + 2).Copy Destination:=ws.Cells(lastRowD + 2, lastColD + 2)


Set ptDM4 = ws.Cells(lastRowD + 2, lastColD + 2).PivotTable

lastRowD = 1 + lastRowD + pp_pt2.TableRange2.Rows.Count

    'create sparklines
    Range(Cells(ptDM4.DataBodyRange.Cells(1, 1).Row, lastColD2), Cells(lastRowD, lastColD2)).SparklineGroups.Add Type:=xlSparkLine, _
    SourceData:=Range(ptDM4.DataBodyRange.Cells(1, 2), ws.Cells(lastRowD, lastColD2 - 2)).Address
    'format sparklines
    With Range(Cells(ptDM4.DataBodyRange.Cells(1, 1).Row, lastColD2), Cells(lastRowD, lastColD2)).SparklineGroups.Item(1)
        .LineWeight = 1.1
        .Points.Markers.Visible = True
        .Points.Markers.Color.ColorIndex = 3
        .SeriesColor.ColorIndex = 32
        .SeriesColor.TintAndShade = 0
    End With

With ws.Range(Cells(3, lastColD + 2), Cells(3, lastColD2))
.MergeCells = True
.Value = "PROMO PRESSURE"
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Font.Bold = True
.Interior.ColorIndex = 32
.Font.ColorIndex = 2
.Font.Size = 16
End With

With ws.Range(Cells(1, 1), Cells(1, lastColD2))
.VerticalAlignment = xlCenter
.Interior.ColorIndex = 32
.Font.ColorIndex = 2
End With


ActiveWindow.DisplayZeros = False

ws.UsedRange.EntireColumn.AutoFit



End Sub

Answer 1

完全忘记发布它，但是我想出的解决方案非常简单，我只是选择了数据透视表的新副本的数据主体，因此：pt.DataBodyRange.Select在创建迷你图之前，每次完成。没有人知道原因和解决方案是什么？

VBA-迷你图-逐步执行和运行代码时得到不同的结果

1 个答案: