从更新的结果生成柱形图

Question

下面的代码，根据今天的日期找到相应的行(日期已经在 A 列中手动写入)，并将数据插入同一行。我需要将最后一个结果(今天的日期)添加到名为"图表"的不同工作表上的柱形图。

Sub Worksheets_Summary()
Dim OldSheet As Worksheet
Dim NewSheet As Worksheet
Dim Cell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim book As Workbook
Set book = ThisWorkbook
Set NewSheet = book.Worksheets("Summary")
RwNum = NewSheet.Columns(1).Find(Date).Row
ColNum = 1
For Each OldSheet In book.Worksheets
If OldSheet.Name <> "Summary" Then
ColNum = ColNum + 1
NewSheet.Cells(1, ColNum).Formula _
= "=HYPERLINK(""#""&CELL(""address"",'" & OldSheet.Name & "'!A1)," _
& """" & OldSheet.Name & """)"

NewSheet.Cells(RwNum, ColNum).Value = OldSheet.Range("B11").Value
End If
Next OldSheet
NewSheet.UsedRange.Columns.AutoFit
End Sub

注意：图表中仅显示新结果。

这是代码运行后的"摘要"工作表： 摘要表

这是代码运行后的仪表板工作表： 仪表板工作表

Answer 1

想要一个非 VBA 方法，一旦你设置好它，你就永远不必弄乱它？

我们将使用一些名称(也称为命名范围)来引用数据。

我假设包含您正在绘制的数据的工作表是"摘要"。

转到公式选项卡，定义名称。在名称中，输入Labels;对于范围，保留工作簿;在"引用"中，输入=Summary!$B$1:$E$1。单击"输入"。

返回到定义名称。在名称中，输入Name;在"引用"中，输入=OFFSET(Summary!$A$1,COUNT(Summary!$A:$A),0)。这将返回 A1 下方的行数与列 A 中的值一样多的单元格。

最后一次返回以定义名称。在名称中，输入Values;在"引用"中，输入=OFFSET(Labels,COUNT(Summary!$A:$A),0)。这将返回的范围，该范围与我们上面命名的Labels范围下的行数一样多，与 A 列中的值数一样多。

现在选择摘要！A1：D2 并在摘要工作表上插入柱形图。图表显示第一个日期的值。选择列并查看系列公式。它应该这样说：

=SERIES(Summary!$A$2,Summary!$B$1:$D$1,Summary!$B$2:$D$2,1)

编辑此公式以阅读

=SERIES(Summary!Name,Summary!Labels,Summary!Values,1)

Excel 接受您的更改。由于"名称"的范围是"工作簿"，Excel 将系列公式更改为以下内容：

=SERIES(Book1.xlsm!Name,Book1.xlsm!Labels,Book1.xlsm!Values,1)

(或任何工作簿的名称)。

Answer 2

好的，看看这是否适合你：

Sub Worksheets_Summary()
Dim OldSheet As Worksheet
Dim NewSheet As Worksheet
Dim Cell As Range
Dim ColNum As Integer
Dim RwNum As Long
Dim book As Workbook
Dim MyChart As Chart
Dim MyRange As Range
Dim Range1 As Range
Dim Range2 As Range
Dim chartSheet As Worksheet

Set book = ThisWorkbook
Set NewSheet = book.Worksheets("Summary")
RwNum = NewSheet.Columns(1).Find(Date).Row
ColNum = 1
For Each OldSheet In book.Worksheets
If OldSheet.Name <> "Summary" Then
ColNum = ColNum + 1
NewSheet.Cells(1, ColNum).Formula _
= "=HYPERLINK(""#""&CELL(""address"",'" & OldSheet.Name & "'!A1)," _
& """" & OldSheet.Name & """)"

NewSheet.Cells(RwNum, ColNum).Value = OldSheet.Range("B11").Value
End If
Next OldSheet
NewSheet.UsedRange.Columns.AutoFit

Set chartSheet = book.Worksheets("charts")
Set MyChart = chartSheet.Shapes.AddChart(xlColumnClustered).Chart 'This is similar to the way I saw it done on the link I included.
'You could use activesheet instead of chartsheet.
Set Range1 = NewSheet.Range("A1:D1") ' Get Header from Summary Sheet
Set Range2 = NewSheet.Range("A" & RwNum & ":D" & RwNum) ' Get most recent data row from Summary Sheet
Set MyRange = Union(Range1, Range2)

MyChart.SetSourceData source:=MyRange 'Use MyRange for the chart.
MyChart.SeriesCollection(1).Name = Range("A" & 2).Value 'Get the date and use it as the chart title.

End Sub

我假设你已经有一个名为"图表"的工作表，所以我没有创建一个。我还假设只有工作表摘要中的最新行被复制到图表工作表中，并且现有数据被覆盖。

我还假设您开始使用的代码已经在更新摘要表。

我用它来学习如何使用 VBA 创建图表：[https://www.mrexcel.com/forum/excel-questions/650547-create-column-chart-through-vba-automatically.html]