在工作中,我有2013年的优秀成绩,并且我在每次迭代时都会在图表系列中添加新数据。 它完美无缺,每次迭代都可以看到图表更新。
现在我尝试使用excel 2016在我的家用电脑上的代码,无论图表赢得什么更新。我尝试了一切
dim chr as ChartObject
dim chrt as Chart
set chr = Sheet1.ChartObjects.Add
set chrt = chr.Chart
然后我尝试了一切像
doevents
chr.refresh
sheet1.enablecalculation = true
application.screenupdating = true
chr.activate
Application.ontime Now + timeSerial(0,0,1), "wt"
sub wt
Application.wait + timeSerial(0,0,1)
end sub
你能想到的任何事情......它不会更新 有什么建议吗?谢谢大家
编辑:我发现如果我添加
就行了Sheet1.ResetAllPageBreaks
在每次迭代结束时,但是它太慢了代码
Sub risolutore()
Application.ScreenUpdating = True
' DICHIARAZIONE DELLE VARIABILI
Dim ws As Worksheet
Dim chr As ChartObject, chr2 As ChartObject
Dim rng As Range, rng2 As Range
Dim grafico As Chart, grafico2 As Chart
'''''''''''''''''''''''''''''''
' SHEET SETTING
Set ws = Foglio5
''''''''''''''''
For Each ch In ws.ChartObjects
ch.Delete
Next ch
'SETTAGGIO DELLE CELLE DI RIFERIMENTO'''''''''''
w_cells = ws.Range("B2:B9").Address
v_cell = ws.Range("B16").Address
s_cell = ws.Range(v_cell).Offset(1, 0).Address
m_cell = ws.Range(v_cell).Offset(2, 0).Address
sum_cell = ws.Range(v_cell).Offset(3, 0).Address
s_col = "F"
wci = "H"
wcf = "O"
nri = 14
ndati = 40
nrf = nri + ndati - 1
m_max = Application.WorksheetFunction.Max(ws.Range(w_cells).Offset(0, 1))
ws.Range(s_col & nri & ":" & wcf & nrf).ClearContents
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
DoEvents
' CICLO RISOLUTORE E GRAFICI
For i = nri To nrf
ws.EnableCalculation = False
ws.EnableCalculation = True
' MIN VAR PORTFOLIO
If i = nri Then
' SETTAGGI DEL RISOLUTORE PER IL MIN VAR PORTFOLIO
obj = ws.Range(s_col & i).Offset(0, 1).Address
'reset dei parametri del solver
Application.Run "Solver.xlam!SolverReset"
'Decido la funzione da ottimizzare
Application.Run "Solver.xlam!SolverOk", v_cell, 2, 0, w_cells, 1, "GRG Nonlinear"
' vincolo di rendimento atteso
'Application.Run "Solver.xlam!SolverAdd", m_cell, 2, obj
' vincolo di peso maggiore di 0
Application.Run "Solver.xlam!SolverAdd", w_cells, 3, "0"
' vincolo di peso minore di 1
Application.Run "Solver.xlam!SolverAdd", w_cells, 1, "=1"
' vincolo di somma pesi uguale a 1
Application.Run "Solver.xlam!SolverAdd", sum_cell, 2, "=1"
Application.Run "Solver.xlam!SolverOptions", , , , , , , , , , , , False
' avvio il solver
Application.Run "Solver.xlam!SolverSolve", True
ws.Range(s_col & i).Value = ws.Range(s_cell).Value
ws.Range(s_col & i).Offset(0, 1).Value = ws.Range(m_cell).Value
ws.Range(s_col & i).NumberFormat = "0.000%"
ws.Range(s_col & i).Offset(0, 1).NumberFormat = "0.000%"
ws.Range(wci & i & ":" & wcf & i).Value = Application.WorksheetFunction.Transpose(ws.Range(w_cells).Value)
ws.Range(wci & i & ":" & wcf & i).NumberFormat = "0.00%"
' DETERMINO I VALORI DEI RENDIMENTI PER IL GRAFICO
m_min = ws.Range(m_cell).Value
max_min = m_max - m_min
Dim v() As Variant
ReDim v(1 To ndati)
v(1) = m_min
For K = LBound(v) + 1 To UBound(v)
v(K) = v(K - 1) + max_min / (ndati - 1)
Next K
ws.Range(s_col & nri).Offset(0, 1).Resize(UBound(v) - LBound(v) + 1).Value = Application.WorksheetFunction.Transpose(v)
ws.Range(s_col & nri).Offset(0, 1).Resize(UBound(v) - LBound(v) + 1).NumberFormat = "0.000%"
' SETTAGGI DEL PRIMO GRAFICO
Set rng = ws.Range("Q13:V25")
Set chr = ws.ChartObjects.Add(Left:=rng.Left, Width:=rng.Width, Top:=rng.Top, Height:=rng.Height)
Set grafico = chr.Chart
grafico.ChartType = xlXYScatterSmooth
grafico.SeriesCollection.NewSeries
grafico.SeriesCollection(1).XValues = ws.Range(s_col & nri).Offset(0, 0)
grafico.SeriesCollection(1).Values = ws.Range(s_col & nri).Offset(0, 1)
grafico.Axes(xlCategory).MinimumScale = ws.Range(s_col & nri).Offset(0, 0) * 0.8
grafico.Axes(xlCategory).TickLabels.Orientation = 35
grafico.Axes(xlValue).MinimumScale = m_min * 0.9
grafico.Axes(xlValue).MaximumScale = m_max * 1.1
grafico.Legend.Delete
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' SETTAGGI DEL SECONDO GRAFICO
Set rng2 = ws.Range("Q26:V42")
Set chr2 = ws.ChartObjects.Add(Left:=rng2.Left, Width:=rng2.Width, Top:=rng2.Top, Height:=rng2.Height)
Set grafico2 = chr2.Chart
grafico2.ChartType = xlAreaStacked100
grafico2.HasTitle = False
grafico2.Legend.Position = xlLegendPositionBottom
grafico2.Axes(xlValue).MinimumScale = 0
For j = 1 To 8
grafico2.SeriesCollection.NewSeries
grafico2.SeriesCollection(j).XValues = ws.Range(s_col & nri & ":" & s_col & nri)
grafico2.SeriesCollection(j).Values = ws.Range(s_col & nri & ":" & s_col & nri).Offset(0, 2 + j - 1)
grafico2.SeriesCollection(j).Name = ws.Range(s_col & nri).Offset(-2, 2 + j - 1)
Next j
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' DETERMINO GLI ALTRI PORTAFOGLI EFFICIENTI
ElseIf i > nri Then
If i = nri + 1 Then
grafico.ChartType = xlXYScatterSmoothNoMarkers
End If
obj = ws.Range(s_col & i).Offset(0, 1).Address
'reset dei parametri del solver
Application.Run "Solver.xlam!SolverReset"
'Decido la funzione da ottimizzare
Application.Run "Solver.xlam!SolverOk", v_cell, 2, 0, w_cells, 1, "GRG Nonlinear"
' vincolo di rendimento atteso
Application.Run "Solver.xlam!SolverAdd", m_cell, 2, obj
' vincolo di peso maggiore di 0
Application.Run "Solver.xlam!SolverAdd", w_cells, 3, "0"
' vincolo di peso minore di 1
Application.Run "Solver.xlam!SolverAdd", w_cells, 1, "=1"
' vincolo di somma pesi uguale a 1
Application.Run "Solver.xlam!SolverAdd", sum_cell, 2, "=1"
Application.Run "Solver.xlam!SolverOptions", , , , , , , , , , , , False
' avvio il solver
Application.Run "Solver.xlam!SolverSolve", True
ws.Range(s_col & i).Value = ws.Range(s_cell).Value
ws.Range(s_col & i).NumberFormat = "0.000%"
ws.Range(wci & i & ":" & wcf & i).Value = Application.WorksheetFunction.Transpose(ws.Range(w_cells).Value)
ws.Range(wci & i & ":" & wcf & i).NumberFormat = "0.00%"
grafico.SeriesCollection(1).XValues = ws.Range(s_col & nri & ":" & s_col & i)
grafico.SeriesCollection(1).Values = ws.Range(s_col & nri & ":" & s_col & i).Offset(0, 1)
For j = 1 To 8
grafico2.SeriesCollection(j).XValues = ws.Range(s_col & nri & ":" & s_col & nrf)
grafico2.SeriesCollection(j).Values = ws.Range(s_col & nri & ":" & s_col & i).Offset(0, 2 + j - 1)
Next j
End If
Next i
Application.ScreenUpdating = True
MsgBox "Ottimizazione Completata", vbInformation
End Sub
答案 0 :(得分:1)
您是否尝试过更改图表数据?
我使用图表,当我更改数据时,图表立即更改。