根据更改输入值的更新数据创建 Excel 图表

Question

事情是这样的：我确实有一个能量模型。结果是墙壁、地板、窗户、通风、屋顶的能量损失数据（瓦特）。我的模型中变化的部分是外部温度。我确实写了一个宏，将这个温度从 -10 变为 10 摄氏度。在正常的饼图中，这很好用。因此温度场发生变化，墙壁、地板等的值在各自的字段中更新。

但这正是我需要的：我想要一个图表（线或散点图），它将显示：所有 5 个（墙壁、地板等）位置的温度（x 轴）和功率（瓦特、y 轴）我失去了能量。

如何做到这一点？我可以（我必须）收集数据，然后最后将其呈现在图表中吗？或者我可以告诉excel在温度变化时用每个新值扩展图表吗？此时我只能或多或少地在字段中显示实际数据。

我希望你能理解我的问题，并希望有人能指出我正确的方向。

这是我目前想出的代码：

Sub BtnBuitenTemp()
Dim PauseTime, Start

Dim ws1 As Worksheet
Set ws1 = Sheets(1)

Dim ws2 As Worksheet
Set ws2 = Sheets(2)

Dim cell As Range

' loop through temperature values given on Sheet(2)
' for now these range from -10 to 10
For Each cell In ws2.Range("A20:A40")

    ' update values in temperature cell
    ws1.Cells.Range("D10").Value = cell.Value

    ' add some pause
    PauseTime = 1
    Start = Timer

    Do While Timer < Start + PauseTime
        DoEvents
    Loop
Next

End Sub

还有截图：

“Temperaturen”中的橙色部分被宏改变了。因此，所有其他数据都将更新并显示在图表中。此时图表只会更新 y 轴值。我想循环温度范围（并将其显示在 x 轴上）并将图表中的前值保持在各自的温度下。 （我也无法显示 x 轴范围。）

（更新）

好的，我现在有一个 XY（散点图）图，我可以设置 x 轴。这是我目前所拥有的：

Sub BtnBuitenTemp()

Dim PauseTime, Start

Dim tbu_min As Integer
Dim tbu_max As Integer

Dim ws1 As Worksheet
Set ws1 = Sheets(1)

' get user values for min and max temp
tbu_min = ws1.Range("TempBuitenMin").Value
tbu_max = ws1.Range("TempBuitenMax").Value

' set chart x axis values to user input
With ws1.ChartObjects("Chart 7").Chart
    With .Axes(xlCategory)
        .MinimumScale = tbu_min
        .MaximumScale = tbu_max
    End With
End With

For temp = tbu_min To tbu_max
    ' update values in temperature cell
    ws1.Cells.Range("D10").Value = temp

    ' add some pause
    PauseTime = 0.5
    Start = Timer

    Do While Timer < Start + PauseTime
        DoEvents
    Loop
Next temp

End Sub

看起来像：

现在我只需要更新正确温度的数据...

• 更新 2 -

我更新了 xy 散点图的数据。我忘了插入“X 系列值”。现在右侧显示在正确的温度下。我现在只需要查看输出；此时它确实每次都会刷新图表。

Answer 1

嗯，我确实解决了我的问题。不是我想要的方式，但我没有时间去寻找另一种方式。我现在只是收集所有数据并从我的宏中绘制图表。这是一个可以解决问题的原型。

Sub BtnBuitenTemp()

Dim PauseTime, Start

Dim tbu_min As Integer
Dim tbu_max As Integer

Dim ws1 As Worksheet
Set ws1 = Sheets(1)

Dim dataSize As Integer
Dim dataCounter As Integer

Dim myChartObject As ChartObject

Dim addTotal As Boolean

' get user values for min and max temp
tbu_min = ws1.Range("TempBuitenMin").Value
tbu_max = ws1.Range("TempBuitenMax").Value

' how many datapoints are there
Dim xPoints() As Integer

' add surfaces
Dim muur() As Integer
Dim vloer() As Integer
Dim ramen() As Integer
Dim dak() As Integer
Dim ventilatie() As Integer
Dim totaal() As Integer

dataSize = Abs(tbu_max - tbu_min)

ReDim xPoints(dataSize)

ReDim muur(dataSize)
ReDim vloer(dataSize)
ReDim ramen(dataSize)
ReDim dak(dataSize)
ReDim ventilatie(dataSize)
ReDim totaal(dataSize)



' collect data
dataCounter = 0
For temp = tbu_min To tbu_max

    ' update values in temperature cell
    ws1.Cells.Range("D10").Value = temp
    ' add x for series
    xPoints(dataCounter) = temp

    ' add data for y series
    muur(dataCounter) = ws1.Cells.Range("O24").Value
    vloer(dataCounter) = ws1.Cells.Range("O47").Value
    ramen(dataCounter) = ws1.Cells.Range("O61").Value
    dak(dataCounter) = ws1.Cells.Range("O35").Value
    ventilatie(dataCounter) = ws1.Cells.Range("O68").Value
    totaal(dataCounter) = ws1.Cells.Range("O74").Value

    ' next
    dataCounter = dataCounter + 1

Next temp


' ask to add total
If MsgBox("Wil je ook het totaal tonen in de grafiek?", vbQuestion + vbYesNo) = vbYes Then
    addTotal = True
Else
    addTotal = False
End If


If Not ChartExists(ws1, "buitentemperatuur") Then
    ' Chart does not exist, create chart

     With ws1.ChartObjects.Add(Left:=200, Width:=600, Top:=200, Height:=400)
        With .chart
            .Parent.Name = "buitentemperatuur"
            .ChartType = xlXYScatterSmooth
            .Axes(xlValue).HasMajorGridlines = False
            .Axes(xlCategory).Crosses = xlMinimum
            .Axes(xlValue).MinimumScale = 0
            .HasLegend = True
            .HasTitle = True
            .ChartTitle.Text = "Invloed van de buitentemperatuur"

        End With
    End With
End If

' Chart does exist, remove old series and update chart
ws1.ChartObjects("buitentemperatuur").Activate
For Each s In ActiveChart.SeriesCollection
    s.Delete
Next s

 With ws1.ChartObjects("buitentemperatuur")
    With .chart

         .Axes(xlValue).MaximumScaleIsAuto = True

         With .SeriesCollection.NewSeries
            .Name = "muur"
            .XValues = xPoints
            .Values = muur
         End With

         With .SeriesCollection.NewSeries
            .Name = "vloer"
            .XValues = xPoints
            .Values = vloer
         End With

         With .SeriesCollection.NewSeries
            .Name = "ramen"
            .XValues = xPoints
            .Values = ramen
         End With

         With .SeriesCollection.NewSeries
            .Name = "dak"
            .XValues = xPoints
            .Values = dak
         End With

         With .SeriesCollection.NewSeries
            .Name = "ventilatie"
            .XValues = xPoints
            .Values = ventilatie
         End With

         If addTotal Then
            With .SeriesCollection.NewSeries
                .Name = "totaal"
                .XValues = xPoints
                .Values = totaal
            End With
        End If

    End With
End With


End Sub

Function ChartExists(wsTest As Worksheet, strChartName As String) As Boolean
Dim chTest As ChartObject

On Error Resume Next
Set chTest = wsTest.ChartObjects(strChartName)
On Error GoTo 0

If chTest Is Nothing Then
    ChartExists = False
Else
    ChartExists = True
End If

End Function