Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1484to1488
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vba Trendlinienformel nutzbar machen
05.04.2016 08:50:26
Johannes
Hallo liebe Excel-Kenner,
ich beschäftige mich jetzt seit einigen Tagen mit VBA und komme leider gerade nicht mehr weiter.....
Hintergrund:
Ich importiere Daten, sortiere mir aus den importierten Daten die für meine Zwecke benötigen Teile heraus, erzeuge mir ein XY-Diagramm, erzeuge mir eine Trendlinie Polynomisch 6 Grad, ersetzte Formelteile so, dass sie theoretisch nutzbar werden und kopiere sie anschließend in meine Zielzelle.
Soweit alles gut, das einzige was nicht funktioniert ist das "Leerzeichen" vor dem "=" weg zu machen, wenn ich dies mache kommt ein Fehler (1004, Anwendungs- oder objektdefinierter Fehler)....
Wenn das Leerzeichen verbleibt wird die Formel wie gewünscht in die Zelle kopiert (als Text oÄ.), ich kann händig das Leerzeichen wegmachen und mit Enter bestätigen und es funktioniert. Auch durch markieren des Bereiches und die Funktion "suchen und ersetzten" funktioniert es. Wenn ich dies mit dem Macrorecorder aufzeichen jedoch wieder nicht, bzw. es passiert nichts...
Anbei hänge ich meinen Code an, die Datei kann ich aufgrund der Daten leider nicht zur Verfügung stellen...
Ich bin wie erwähnt Leihe deswegen ist der Code bestimmt nicht so dolle :)
Aber ich hoffe sehr das ihr mir bei meinem Problem weiterhelfen könnt!
Wie erwähnt geht es darum die Formel in der Zielzelle nutzbar zu machen.
Viele Grüße
Johannes
---------------------------------------------------------------------------

Sub csv_Import()
' csv_Import Makro
Cells.Select
Selection.ClearContents
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Neue Datei einlesen").ChartObjects.Delete
Application.DisplayAlerts = True
On Error GoTo 0
'Variablen deklarieren-------------------------------------------------------------------------- _
_
Dim Dateiname As Variant
Dim suche1 As Integer
Dim suche2 As Integer
Dim suche3 As Integer
Dim bereich1 As Integer
Dim a As Integer
Dim b As Integer
Dim c As Integer
Dim for_i As Integer
Dim ax As Integer
Dim ay As Integer
Dim strFormel1 As String
Dim strFormel2 As String
'Datei importieren------------------------------------------------------------------------------ _
_
Dateiname = Application.GetOpenFilename("Alle Dateien,*.*")
If Dateiname = False Then Exit Sub
' Import der csv-Datei
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & Dateiname, Destination:=Range("$A$1") _
_
)
.Name = "Materialdaten"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1)
.TextFileDecimalSeparator = "."
.TextFileThousandsSeparator = ","
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'Suchen nach Schlüsselworten-------------------------------------------------------------------- _
_
suche1 = Application.Match("!--- Wõrmeleitfõhigkeit W/m? K", Range("A1:A300"), 0) + 5
suche2 = Application.Match("kxx", Range("B1:B300"), 0)
suche3 = Cells(suche2, 2).End(xlDown).Row
'Sheets("Neue Datei einlesen").Range("M1").Value = suche1
'Sheets("Neue Datei einlesen").Range("M2").Value = suche2
'Sheets("Neue Datei einlesen").Range("M3").Value = suche3
'Temperaturen kopieren und transponieren------------------------------------------------------
a = suche1 - 1
Sheets("Neue Datei einlesen").Cells(a, 14).Value = "Temperatur"
a = suche1
For for_i = 0 To suche2 - 2 - suche1
a = suche1 + for_i
ax = suche1 + 6 * for_i
Range(Cells(a, 3), Cells(a, 8)).Select
Selection.Copy
Cells(ax, 14).Select
Selection.PasteSpecial Transpose:=True
Next for_i
'Wärmeleitfähigkeiten kopieren und transponieren------------------------------------------------ _
_
a = suche1 - 1
Sheets("Neue Datei einlesen").Cells(a, 15).Value = "Wärmeleitfähigkeit"
a = suche1
For for_i = 0 To suche2 - 2 - suche1
b = suche2 + for_i
ax = a + 6 * for_i
Range(Cells(b, 5), Cells(b, 10)).Select
Selection.Copy
Cells(ax, 15).Select
Selection.PasteSpecial Transpose:=True
Next for_i
'Diagramm erzeugen------------------------------------------------------------------------------ _
_
ay = suche1
ax = Cells(suche1, 15).End(xlDown).Row
Range(Cells(ay, 14), Cells(ax, 15)).Select
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlXYScatter
ActiveChart.SetSourceData Source:=Range(Cells(ay, 14), Cells(ax, 15))
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Trendlines.Add
ActiveChart.SeriesCollection(1).Trendlines(1).Select
With Selection
.Type = xlPolynomial
.Order = 6
End With
Selection.DisplayEquation = True
ActiveChart.SeriesCollection(1).Select
ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select
Selection.NumberFormat = "#0,.E+00"
Selection.NumberFormat = "#0,.0000000000000000000000E+00"
ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Select              'wichtig für Formel  _
_
auslesen
strFormel1 = ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Text   'wichtig für Formel  _
_
auslesen
strFormel2 = ActiveChart.SeriesCollection(1).Trendlines(1).DataLabel.Text   'wichtig für Formel  _
_
auslesen
'Formel in Zelle kopieren und Zeichen anpassen-------------------------------------------------- _
_
a = suche1 - 1
Sheets("Neue Datei einlesen").Cells(a, 16).Value = "Neue Wärmeleitfähigkeit"
For for_i = 0 To ax - suche1
c = suche1 + for_i
strFormel2 = Replace(Replace(Replace(Replace(strFormel1, "y", ""), "E", "*10^"), "x", "*x^") _
_
, ",000", "0,000")
strFormel2 = Replace(strFormel2, "x", Cells(c, "N"))
strFormel2 = Replace(strFormel2, "^ +", "+")
strFormel2 = Replace(Replace(strFormel2, " ", ""), "=", " =")
'strFormel2 = Replace(strFormel2, " =", "=")
Sheets("Neue Datei einlesen").Cells(c, 16) = strFormel2
Next for_i
Range(Cells(ay, 16), Cells(c, 16)).Select
Selection.Replace What:=" =", Replacement:="=", LookAt:=xlPart, SearchOrder:=xlByRows,  _
MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
End Sub

----------------------------------------------------------------------------------

4
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Vba Trendlinienformel nutzbar machen
05.04.2016 13:25:08
Steve
Hallo Johannes,
kannst du uns mal die Inputs und das Ergebnis deiner Formelumstellung zeigen? (Befehl Debug.Print)
Die Labeltexte wären vor allem wichtig, aber auch das Ergebnis was vor der Zeile "Sheets("Neue Datei einlesen").Cells(c, 16) = strFormel2" in strFormel2 enthalten ist. Wir können sonst nicht ansatzweise nachvollziehen was du da machst.
Ein anderer Tipp, ich weis ja nicht warum du ein Diagramm erzeugen musst, oft reicht es aus das Diagramm in einem Tabellenblatt als Vorlage liegen zu haben, sich dieses zu kopieren und nur die Werte zu ändern. Das geht um vieles einfacher. Zudem solltest du dir "Select" abgewöhnen. Das ist unnötig und bremst deinen Code aus, noch dazu ist es unschön wenn die Markierung hin und herspringt.
lg Steve

Anzeige
AW: Vba Trendlinienformel nutzbar machen
05.04.2016 14:28:40
Johannes
Hallo,
ich habe die Daten gekürzt und hochgeladen.
https://www.herber.de/bbs/user/104779.xlsm
Die Formel in P28 und drunter soll eigentlich ausgeführt werden und mir dann ein Ergebnis liefern...
Hoffe so wird es verständlicher.
Das Ergebnis nach dem du gefragt hast sieht wie folgt aus:
=8,9619341209485200000000*10^-16*25^6-2,4527845157155600000000*10^-12*25^5+24,7862402196335000000000*10^-10*25^4-1,1384435740670800000000*10^-06*25^3+2,6665405584495100000000*10^-04*25^2-9,4292767571144500000000*10^-02*25+72,1781546969350000000000*10^+00
wie gesagt, vor dem "=" ist ein Leerzeichen welches eigentlich nur entfernt werden muss.
Wenn ich die Formeln manuell markiere und suchen und ersetzten " =" durch "=" eingebe funktioniert es.
Viele Grüße
Johannes

Anzeige
AW: Vba Trendlinienformel nutzbar machen
05.04.2016 14:44:56
Steve
Hallo Johannes,
VBA spricht englisch und verwendet das Dezimaltrennzeichen Punkt statt Komma. Du musst also zunächst diese mit Replace() austauschen oder du verwendest bei der Zelle die .FormulaLocal Eigenschaft statt .Value, wodurch die lokal eingestellte Sprache des am PC angemeldeten Benutzers (deutsch) mit entsprechendem Dezimaltrennzeichen benutzt wird. Damit die Formel dann nur ein Wert ist kann man ihn ja hinterher festschreiben.
Das ist auch der Grund warum es durch das spätere entfernen des Leerzeichens geht, weil dann auf deutsch gerechnet wird und er das Komma korrekt erkennt.
lg Steve

Anzeige
AW: Vba Trendlinienformel nutzbar machen
05.04.2016 15:08:11
Johannes
Der Hammer,
so ein kleiner Fehler und ich hab ewig drangehangen....
Viele Dank! Jetzt funktioniert es wie ich mir das vorgestellt habe :)

313 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige