2015-11-30 83 views
1

這是事情:我確實有能源模型。結果是牆壁,地板,窗戶,通風,屋頂的能量損失的數據(瓦特)。我模型中的變化部分是外部溫度。我編寫了一個宏,將溫度從-10攝氏度改爲10攝氏度。在正常的餅圖中,這很好地工作。因此,溫度場會發生變化,牆壁,地板等的值會在各自的領域更新。我想要一個圖形(線條或散點圖),顯示所有5個(牆壁,地板等)的溫度(x軸)和功率(瓦特,y軸)我失去了能量。根據更改輸入值的更新數據創建Excel圖形

如何做到這一點?我可以(我必須)收集數據,然後在最後呈現在圖表中嗎?或者,當溫度變化時,我可以告訴excel擴展每個新值的圖表嗎?此時,我只能在或多或少的字段中顯示實際的數據。

我希望你能理解我的問題,並且有人能指引我走向正確的方向。

這是我想出了到目前爲止的代碼:由宏改變了 「Temperaturen」

enter image description here

橙色部分:

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 

和截圖。因此所有其他數據將被更新並顯示在圖表中。該圖表只會更新此時的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 

而且,看起來像:

enter image description here

現在我只需要更新在合適的溫度數據...

  • 更新2 -

我更新了我的xy數據散點圖。我忘了插入「系列X值」。現在右邊顯示的溫度是正確的。我現在只需要保持輸出的視野;此時它每次都刷新圖形。

enter image description here

+0

如果你可以添加你的代碼和一些截圖,我會非常支持我們來幫助你! ;)http://stackoverflow.com/help/how-to-ask – R3uK

+1

Sry。更新。 – ProX

+0

好,所以你只有一行或一列的一部分,將成爲你的數據系列中的一個數據點。而且我猜測當溫度改變在相同的地方被覆蓋時重新計算的值?你能告訴我們這是什麼嗎?範圍的地址會很好:像C3:C9或其他東西! ;) – R3uK

回答

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