Question

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

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

怎么做？我可以（我必须）收集数据，然后最终将其显示在图表中吗？或者我可以告诉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

截图：

橙色部分＆＃34;温度＆＃34;被宏改变了。因此，所有其他数据将更新并显示在图表中。该图表仅在此时更新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散点图的数据。我忘了插入＆＃34; X系列值＆＃34;。现在右边显示的温度合适。我现在只需要保持输出视图;此时它每次都刷新图表。

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

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

1 个答案: