是否可以基于相同的图表标题排列图表-同一行中的图表标题相同

Question

我在工作表中有很多图表要按顺序排列。我得到了将一行图表连续排列3个的代码，但我想要的是标题相同的图表排在同一行。

 Sub CHART_ARRANGE()

' chart size - adjust as desired
' set one or both to zero to use dimensions of active chart
'   (or first chart if no chart is active)
Const nRowsTall As Long = 0
Const nColsWide As Long = 0

' chart layout - adjust as desired
Const nChartsPerRow As Long = 3
Const nSkipRows As Long = 2
Const nSkipCols As Long = 1
Const nFirstRow As Long = 1
Const nFirstCol As Long = 1

Dim iChart As Long
Dim chtob As ChartObject
Dim dWidth As Double
Dim dHeight As Double
Dim rData As Range
Dim dFirstChartTop As Double
Dim dFirstChartLeft As Double
Dim dRowsBetweenChart As Double
Dim dColsBetweenChart As Double

If ActiveSheet.ChartObjects.Count > 0 Then

With ActiveSheet.Cells(nFirstRow, nFirstCol)
  If nRowsTall * nColsWide > 0 Then
    dWidth = nColsWide * .Width
    dHeight = nRowsTall * .Height
  Else
    If Not ActiveChart Is Nothing Then
      Set chtob = ActiveChart.Parent
    Else
      Set chtob = ActiveSheet.ChartObjects(1)
    End If
    dWidth = chtob.Width
    dHeight = chtob.Height
  End If

  dFirstChartLeft = .Left
  dFirstChartTop = .Top
  dRowsBetweenChart = nSkipRows * .Height
  dColsBetweenChart = nSkipCols * .Width
End With

For iChart = 1 To ActiveSheet.ChartObjects.Count

  Set chtob = ActiveSheet.ChartObjects(iChart)

  With chtob
    .Left = ((iChart - 1) Mod nChartsPerRow) * _
        (dWidth + dColsBetweenChart) + dFirstChartLeft
    .Top = Int((iChart - 1) / nChartsPerRow) * _
        (dHeight + dRowsBetweenChart) + dFirstChartTop
    .Width = dWidth
    .Height = dHeight
  End With

Next

End If

End Sub

如何修改代码以使具有相同标题的图表与上述图表位于同一行。

Answer 1

实际编码取决于确切的要求。我做了一个简单的示例，按标题排列所有图表。它有一些局限性（例如，它不进行排序），并将所有具有相同标题的图表放在同一行。

代码使用字典，以图表标题作为键，并包含一个逻辑位置（包含行和列）和值。

它遍历所有图表，获取标题并检查标题是否已在字典中。如果是，它将获得具有相同标题的前一个图表的位置，并将逻辑列增加1。如果不是，则将新的逻辑行添加到字典中（其中row =字典的大小，col = 0）。 / p>

通过使用逻辑位置乘以某些常数来计算forecast1<-ts(lapply(arima, function(x) forecast(auto.arima(x), level=95))) autoplot(forecast1) hchart(forecast1) 和Width来放置图表。

Height

您需要一个对象类型来保持逻辑位置，因此添加一个名为Sub sortChartsByTitle() Const startX = 50 ' Left margin Const startY = 50 ' Top margin Const deltaX = 400 Const deltay = 260 Dim chartTitleList As Dictionary, co As ChartObject Dim chartPos As cPos Set chartTitleList = New Dictionary For Each co In ActiveSheet.ChartObjects Dim title As String title = "" If co.Chart.HasTitle Then title = co.Chart.ChartTitle.Text ' Get ChartTitle (if any) End If If title = "" Then title = "(no title)" ' Set a default if chart has no title or title is empty End If If chartTitleList.Exists(title) Then ' There was already one chart with same title. Set chartPos = chartTitleList(title) ' Get logical position chartPos.col = chartPos.col + 1 ' Jump one to the left Set chartTitleList(title) = chartPos ' Remember thus new position Else Set chartPos = New cPos ' Create a new logical position chartPos.row = chartTitleList.Count ' Row = size of dictionary chartPos.col = 0 ' Col = 0 Call chartTitleList.Add(title, chartPos) ' Add to Dictionary End If ' Position chart co.Left = startX + chartPos.col * deltaX co.Top = startY + chartPos.row * deltay Next co End Sub 的类模块。您所需要的就是（当然您可以用setter和getter来包装它……）

cPos