Thema Datum  Von Nutzer Rating
Antwort
04.10.2020 11:03:33 Julian
NotSolved
04.10.2020 12:29:14 Gast35017
NotSolved
04.10.2020 12:38:40 Julian
NotSolved
04.10.2020 13:05:24 Gast74874
NotSolved
04.10.2020 14:40:34 Julian
NotSolved
04.10.2020 14:58:42 Gast37263
*
NotSolved
04.10.2020 15:28:41 Gast37263
**
NotSolved
04.10.2020 15:04:28 Gast37263
NotSolved
04.10.2020 15:07:57 Gast37263
NotSolved
04.10.2020 15:10:56 Gast37263
NotSolved
04.10.2020 15:34:41 Gast37263
NotSolved
04.10.2020 15:51:35 Julian
NotSolved
Rot Dann mal zur Frage: Wie änderst du die Quelldaten überhaupt?
04.10.2020 17:17:23 Gast37263
*****
Solved
04.10.2020 17:39:43 Gast21086
*****
Solved
04.10.2020 18:46:14 Julian
Solved
04.10.2020 19:45:00 Gast37263
NotSolved

Ansicht des Beitrags:
Von:
Gast37263
Datum:
04.10.2020 17:17:23
Views:
562
Rating: Antwort:
 Nein
Thema:
Dann mal zur Frage: Wie änderst du die Quelldaten überhaupt?

Ok, folgendes:

Das Makro rennt derart schnell durch, dass zu dem Zeitpunkt an dem du die Kooefizienten abfragen willst, mitunter noch gar nichts fertig aufgefrischt wurde. (Darum sind auch alle Kooefz. gleich)

Ich hab jetzt folgendes gemacht:

#1 - Test-Prozedur umgeschrieben

Randnotiz: Sheet7 -> siehe #2

'
' Module: Damper_Booster_Curves_Chart
'
Option Explicit 'non global or non modular variables used in Subs or funcitons have to be declared by dim
Option Base 1 ' all arrays start with index 1

Public Sub TestChartRefresh()
    
    Dim vntNameList As Variant
    Dim vntName As Variant
    Dim coeffA As Double
    Dim coeffB As Double
    
    vntNameList = Array("EAF-DEC-damper", "curve2", "curve1")
    
    For Each vntName In vntNameList
      Call Sheet7.GetDamperCurveTrendCoefficients(vntName, coeffA, coeffB)
      Debug.Print "['"; CStr(vntName); "']:"; Tab(25); "CoeffA: " & Format$(coeffA, "0.00") & "; CoeffB: " & Format$(coeffB, "0.00")
    Next
    
End Sub

-> liefert nach Ausführen:

['EAF-DEC-damper']:     CoeffA: 420,66; CoeffB: -0,10
['curve2']:             CoeffA: 512,00; CoeffB: -0,07
['curve1']:             CoeffA: 149,58; CoeffB: -0,07

#2 - Alle Funktionen die die Graphen betreffen in das entspr. Blatt gepackt.

Randnotiz: Derzeit hat dieses Blatt den Codenamen "Sheet7". Ändere in ab in z.B. "tblDamperCurves" dann kannst du dieses im Makro unter jenem Namen ansprechen. Darum steht unter #1 zum ansprechen von GetDamperCurveTrendCoefficients() aktuell noch Sheet7.

'
' Sheet: "DAMPER-CURVES"
'
Option Explicit 'non global or non modular variables used in Subs or funcitons have to be declared by dim
Option Base 1 ' all arrays start with index 1


Private WithEvents Chart_NormalScaling As Excel.Chart
Private WithEvents Chart_LogarithmicScaling As Excel.Chart



Private Sub Chart_NormalScaling_Calculate()
'  Debug.Print Time$, "Chart_NormalScaling_Calculate"
  DoEvents 'Excel Zeit zum Denken geben
End Sub

Private Sub Chart_LogarithmicScaling_Calculate()
'  Debug.Print Time$, "Chart_LogarithmicScaling_Calculate"
  DoEvents 'Excel Zeit zum Denken geben
End Sub



Public Function GetDamperCurveTrendCoefficients(ByVal curveName As String, ByRef coeffA As Double, ByRef coeffB As Double)
    'returns  A and B coefficients by reference of a chart trendline with the form [y = A * exp(B*x)]
    
    Set Chart_NormalScaling = ChartObjects(damperCurveNormalScaling).Chart
    Set Chart_LogarithmicScaling = ChartObjects(damperCurveLogarithmicScaling).Chart
    
    Dim currentChart As Chart
    Dim fName As String 'filename
    Dim formulaString As String
    Dim splitA() As String
    Dim SplitB() As String
    
    'save filename
    fName = ThisWorkbook.Path & "\temp.gif"
    
    'update the chart source data to the curve with the curveName
    Call SetChartData(Me, curveName, damperCurveNormalScaling, damperCurveLogarithmicScaling)
    
    'get the exp Trendline formula as string
    formulaString = Chart_NormalScaling.SeriesCollection(1).Trendlines(1).DataLabel.text
    
    'String treatments to get coeffA and coeffB
    splitA = Split(Replace(formulaString, "y = ", ""), "e")
    SplitB = Split(splitA(1), "x")
    
    'RETURN Coefficients
    coeffA = splitA(0) 'return CoeffA
    coeffB = SplitB(0) 'return CoeffB
    
End Function

Private Function LastUsedRow(ByVal Worksheet As Excel.Worksheet) As Long
'Finds the last non-blank cell on a sheet/range, if no parameter is set it will search by default in the active worksheet
    Dim lRow As Long
    
    On Error Resume Next
        lRow = Worksheet.Cells.Find(What:="*", _
                        after:=Range("A1"), _
                        LookAt:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).row

        LastUsedRow = lRow
    On Error GoTo 0
End Function

Private Function LastUsedColumn(ByVal Worksheet As Excel.Worksheet) As Long
'Finds the last non-blank column on a sheet/range, if no parameter is set it will search by default in the active worksheet
    Dim lCol As Long
    
    On Error Resume Next
        lCol = Worksheet.Cells.Find(What:="*", _
                        after:=Range("A1"), _
                        LookAt:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByColumns, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Column
        LastUsedColumn = lCol
    On Error GoTo 0
End Function

Private Function SetChartData(ByVal Worksheet As Excel.Worksheet, _
                            ByVal curveName As String, _
                            ByVal normalScalingChartName As String, _
                            ByVal logScalingChartName As String)
    'searches for the curveName and updates both charts (normal and logarithmic scaling)
    Dim i As Integer
    Dim chartDataRange As Range
    
    If curveName = "" Then
        Exit Function
    End If
    
    'search for curveName and change Source for Chart-Data
    For i = DAMPER_CURVES_DATA_1stROW To LastUsedRow(Worksheet)
        With Worksheet
            If .Cells(i, 1).value = curveName Then
                Set chartDataRange = .Range(.Cells(i, DAMPER_CURVES_DATA_1stCOL), _
                                            .Cells(i + 1, DAMPER_CURVES_DATA_1stCOL + 29)) 'data range (30 possible data pairs)
                Call .ChartObjects(normalScalingChartName).Chart.SetSourceData(Source:=chartDataRange)
                Call .ChartObjects(logScalingChartName).Chart.SetSourceData(Source:=chartDataRange)
                Exit Function
            End If
        End With
    Next
End Function

'Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range, Cancel As Boolean)
'   'a doubleclick on a name cell of the damper curves updates the chartData
'
'    'check valid range
'    If Application.ActiveCell.Column = 1 _
'        And Application.ActiveCell.row > DAMPER_CURVES_DATA_1stROW - 1 _
'        And Application.ActiveCell.row < LastUsedRow(ActiveSheet) Then

'        Call SetChartData(ActiveSheet, Application.ActiveCell.value, damperCurveNormalScaling, damperCurveLogarithmicScaling)
'        Cancel = False 'don't continue after double click
'    Else
'        Cancel = False 'normal double click --> set courser in cell
'    End If
'End Sub

Weitere Anmerkungen:

1) LastUsedRow in Spalte A:

Private Function LastUsedRow() As Long
  With Sheet7
    With .Cells(.Rows.Count, "A").End(xlUp)
      If .MergeCells Then
        LastUsedRow = .Row + .MergeArea.Rows.Count - 1
      Else
        LastUsedRow = .Row
      End If
    End With
  End With
End Function

Da die Funktion in "Sheet7" liegt, könnte man dafür auch einfach Me schreiben.

2) LastUsedColumn ist analog 1).

3) In SetChartData() kannst du per Range.Find()-Methode nach dem curveName suchen und so auf die For-Schleife verzichten.

 

Das wars erstmal. :)

 

Beste Grüße

Trägheit


Ihre Antwort
  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen
Thema: Name: Email:



  • Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
  • Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
  • Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
  • Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
  • Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei Antworten auf Ihren Beitrag zu benachrichtigen

Thema Datum  Von Nutzer Rating
Antwort
04.10.2020 11:03:33 Julian
NotSolved
04.10.2020 12:29:14 Gast35017
NotSolved
04.10.2020 12:38:40 Julian
NotSolved
04.10.2020 13:05:24 Gast74874
NotSolved
04.10.2020 14:40:34 Julian
NotSolved
04.10.2020 14:58:42 Gast37263
*
NotSolved
04.10.2020 15:28:41 Gast37263
**
NotSolved
04.10.2020 15:04:28 Gast37263
NotSolved
04.10.2020 15:07:57 Gast37263
NotSolved
04.10.2020 15:10:56 Gast37263
NotSolved
04.10.2020 15:34:41 Gast37263
NotSolved
04.10.2020 15:51:35 Julian
NotSolved
Rot Dann mal zur Frage: Wie änderst du die Quelldaten überhaupt?
04.10.2020 17:17:23 Gast37263
*****
Solved
04.10.2020 17:39:43 Gast21086
*****
Solved
04.10.2020 18:46:14 Julian
Solved
04.10.2020 19:45:00 Gast37263
NotSolved