Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1220to1224
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
Inhaltsverzeichnis

Eigene Excel Funktion - substitute

Eigene Excel Funktion - substitute
lutz
Hallo Excel Profis,
ich habe mri eine Excel-Funktion geschrieben mit der ich dann den Inhalt von Zellen berechne:
Function Berechne(txt As String)
txt = Application.Substitute(txt, "ø", "")
Berechne = Evaluate(txt)
End Function
Jetzt steht aber hinter dem "ø" auch noch etwas was nicht berechnet werden soll: 4x ø 15 x 4 - das ø 15 soll also ignoriert werden.
Genauso sollen alle anderen Zeichen bis auf Zahlen und x, *, +, /, - nicht berücksichtigt werden.
Wenn also jemand 4 x meyer 4 schreibt soll nur 4x4 gerechnet werden.
Wie kann man das machen?
Vielen Dank für eure Hilfe
Viele Grüße Lutz
AW: Eigene Excel Funktion - substitute
19.07.2011 11:34:16
Rudi
Hallo,
bis auf Zahlen und x, *, +, /, -
und was ist bei 5+Axolotl 3? 5+x3?
Gruß
Rudi
Kennst du Axolotl?
AW: Eigene Excel Funktion - substitute
19.07.2011 11:55:54
lutz
Hallo Rudi,
da hast du Recht...
Ich habe jetzt für jeden Buchstaben Groß/Klein
txt = Application.Substitute(txt, "q", "")
gemacht, das hilft
wenn ich dann noch
txt = Application.Substitute(txt, "xx", "x")
txt = Application.Substitute(txt, "//", "/")
txt = Application.Substitute(txt, "**", "*")
txt = Application.Substitute(txt, "--", "-")
txt = Application.Substitute(txt, "++", "+")
txt = Application.Substitute(txt, "+x", "+")
txt = Application.Substitute(txt, "++", "+")
txt = Application.Substitute(txt, "+/", "+")
txt = Application.Substitute(txt, "+-", "+")
txt = Application.Substitute(txt, "+*", "+")
etc
mache müßte auch dein Kumpel Axolotl erledigt sein - oder?
Aber eines bleibt: wie bekomme ich die Zeichen ab dem ø bis zum nächsten Operatoren raus?
Vielen Dank und viele Grüße Lutz
Anzeige
AW: Eigene Excel Funktion - substitute
19.07.2011 12:56:48
lutz
Hallo zusammen,
ich habe jetzt mal erst
txt = Application.Substitute(txt, " ", "")
txt = Application.Substitute(txt, ",", ".")
txt = Application.Substitute(txt, "ø1", "")
txt = Application.Substitute(txt, "ø2", "")
txt = Application.Substitute(txt, "ø3", "")
txt = Application.Substitute(txt, "ø4", "")
txt = Application.Substitute(txt, "ø5", "")
gebastelt aber mehr als 1000 codes davon will Excel nicht (habe ich mir per Formel gebastelt)
Kann man eine Schleibe machen die er abarbeitet im Sinne i = 1 bis 10000
und dann
txt = Application.Substitute(txt, "øi", "") for each i?
Kenne mich mit Schleifen leider gar nicht aus.
Ansonsten müßte man sagen, nimm alles ab ø bis zum nächsten +,-,*,/ und entferne das.
Vielen Dank Grüß Lutz
Anzeige
Ja, kann man! Ansonsten ist das, was du...
19.07.2011 13:47:33
Luc:-?
…vorhast, Lutz,
eher ein Fall für eine UDF, die Mathe- (inkl Textaufgaben), nicht XL-Formeln (wie Evaluate) evaluiert, aber die müsstest du wohl komplett selber schreiben. Das können dann, je nach Anspruch, zwischen einigen Dutzend und einigen Tsd PgmZeilen wdn.
Ansonsten hier mal ein PgmZyklus für's Ersetzen:
Const TxtZ As String = " ;,;ø1;ø2;ø3;ø4;ø5", ErsZ As String = ";.;;;;;"
Dim i As Long, varErs, varTxt As Variant
varErs = Split(ErsZ, ";"): varTxt = Split(TxtZ, ";")
…
For i = 0 To Ubound(varTxt)
txt = Replace(Txt, varTxt(i), varErs(i))
Next i
…
Gruß Luc :-?
Anzeige
AW: Ja, kann man! Ansonsten ist das, was du...
19.07.2011 17:40:12
lutz
Hallo Luc,
sorry war mal außer Haus.
Vielen Dank, ich fürchte das ist dann zu kompliziert für mich...
Ich habe mir jetzt eine Schleife eingebaut (tatsächlich selber ohne Hilfe!!)
Dim i As Integer
For i = 10000 To 1 Step -1
txt = Application.Substitute(txt, "ø" & i, "")
Next i
Funktioniert auch Klasse, ich würde jetzt nur noch vor der Schleife abpuffern, ob überhaupt ein "ø" in dem String vorkommt - wahrscheinlich mit If...
Weißt Du was ich davor/drumrum bauen muß?
Toll wäre auch eine Fehlerausgabe wenn i größer 10000 ist
Viele Grüße Lutz
AW: Ja, kann man! Ansonsten ist das, was du...
19.07.2011 17:53:15
lutz
Hallo zusammen,
ich habe jetzt das zusammengebastelt:
Function Berechne(txt As String)
txt = Application.Substitute(txt, " ", "")
txt = Application.Substitute(txt, ",", ".")
txt = Application.Substitute(txt, "x", "*")
txt = Application.Substitute(txt, "X", "*")
If InStr(txt, "ø") > 0 Then
Dim i As Integer
For i = 10000 To 1 Step -1
txt = Application.Substitute(txt, "ø" & i, "")
Next i
End If
txt = Application.Substitute(txt, "ø", "")
txt = Application.Substitute(txt, "tief", "")
txt = Application.Substitute(txt, "hoch", "")
txt = Application.Substitute(txt, "breit", "")
txt = Application.Substitute(txt, "Tief", "")
txt = Application.Substitute(txt, "Hoch", "")
txt = Application.Substitute(txt, "Breit", "")
txt = Application.Substitute(txt, "m", "")
txt = Application.Substitute(txt, "M", "")
txt = Application.Substitute(txt, "mm", "")
txt = Application.Substitute(txt, "MM", "")
txt = Application.Substitute(txt, "×", "*")
txt = Application.Substitute(txt, "A", "")
txt = Application.Substitute(txt, "B", "")
txt = Application.Substitute(txt, "C", "")
txt = Application.Substitute(txt, "D", "")
txt = Application.Substitute(txt, "E", "")
txt = Application.Substitute(txt, "F", "")
txt = Application.Substitute(txt, "G", "")
txt = Application.Substitute(txt, "H", "")
txt = Application.Substitute(txt, "I", "")
txt = Application.Substitute(txt, "J", "")
txt = Application.Substitute(txt, "K", "")
txt = Application.Substitute(txt, "L", "")
txt = Application.Substitute(txt, "M", "")
txt = Application.Substitute(txt, "N", "")
txt = Application.Substitute(txt, "O", "")
txt = Application.Substitute(txt, "P", "")
txt = Application.Substitute(txt, "Q", "")
txt = Application.Substitute(txt, "R", "")
txt = Application.Substitute(txt, "S", "")
txt = Application.Substitute(txt, "T", "")
txt = Application.Substitute(txt, "U", "")
txt = Application.Substitute(txt, "V", "")
txt = Application.Substitute(txt, "W", "")
txt = Application.Substitute(txt, "Y", "")
txt = Application.Substitute(txt, "Z", "")
txt = Application.Substitute(txt, "ß", "")
txt = Application.Substitute(txt, "Ü", "")
txt = Application.Substitute(txt, "Ö", "")
txt = Application.Substitute(txt, "Ä", "")
txt = Application.Substitute(txt, "a", "")
txt = Application.Substitute(txt, "b", "")
txt = Application.Substitute(txt, "c", "")
txt = Application.Substitute(txt, "d", "")
txt = Application.Substitute(txt, "e", "")
txt = Application.Substitute(txt, "f", "")
txt = Application.Substitute(txt, "g", "")
txt = Application.Substitute(txt, "h", "")
txt = Application.Substitute(txt, "i", "")
txt = Application.Substitute(txt, "j", "")
txt = Application.Substitute(txt, "k", "")
txt = Application.Substitute(txt, "l", "")
txt = Application.Substitute(txt, "m", "")
txt = Application.Substitute(txt, "n", "")
txt = Application.Substitute(txt, "o", "")
txt = Application.Substitute(txt, "p", "")
txt = Application.Substitute(txt, "q", "")
txt = Application.Substitute(txt, "r", "")
txt = Application.Substitute(txt, "s", "")
txt = Application.Substitute(txt, "t", "")
txt = Application.Substitute(txt, "u", "")
txt = Application.Substitute(txt, "v", "")
txt = Application.Substitute(txt, "w", "")
txt = Application.Substitute(txt, "y", "")
txt = Application.Substitute(txt, "z", "")
txt = Application.Substitute(txt, "ü", "")
txt = Application.Substitute(txt, "ö", "")
txt = Application.Substitute(txt, "ä", "")
txt = Application.Substitute(txt, "xx", "x")
txt = Application.Substitute(txt, "//", "/")
txt = Application.Substitute(txt, "**", "*")
txt = Application.Substitute(txt, "--", "-")
txt = Application.Substitute(txt, "++", "+")
txt = Application.Substitute(txt, "+x", "+")
txt = Application.Substitute(txt, "++", "+")
txt = Application.Substitute(txt, "+/", "+")
txt = Application.Substitute(txt, "+-", "+")
txt = Application.Substitute(txt, "+*", "+")
txt = Application.Substitute(txt, "-x", "-")
txt = Application.Substitute(txt, "-+", "-")
txt = Application.Substitute(txt, "-/", "-")
txt = Application.Substitute(txt, "--", "-")
txt = Application.Substitute(txt, "-*", "-")
txt = Application.Substitute(txt, "xx", "x")
txt = Application.Substitute(txt, "x+", "x")
txt = Application.Substitute(txt, "x/", "x")
txt = Application.Substitute(txt, "x-", "x")
txt = Application.Substitute(txt, "x*", "x")
txt = Application.Substitute(txt, "/x", "/")
txt = Application.Substitute(txt, "/+", "/")
txt = Application.Substitute(txt, "//", "/")
txt = Application.Substitute(txt, "/-", "/")
txt = Application.Substitute(txt, "/*", "/")
txt = Application.Substitute(txt, "*x", "*")
txt = Application.Substitute(txt, "*+", "*")
txt = Application.Substitute(txt, "*/", "*")
txt = Application.Substitute(txt, "*-", "*")
txt = Application.Substitute(txt, "**", "*")
Berechne = Evaluate(txt)
End Function
Kann man das noch etwas kürzer/schneller machen?
Und es wäre gut eine Meldung zu bekommen wenn hinter dem Durchschnitte etwas größer 10000 steht.
Vielen Dank und viele Grüße Lutz
Anzeige
AW: Ja, kann man! Ansonsten ist das, was du...
19.07.2011 20:13:45
Rudi
Hallo,
zumindest A-Z, a-z kannst du in einer Schleife erledigen.
For i = 65 To 90
txt = Application.Substitute(txt, Chr(i), "")
txt = Application.Substitute(txt, LCase(Chr(i)), "")
Next i
Gruß
Rudi
AW: Ja, kann man! Ansonsten ist das, was du...
19.07.2011 23:50:43
lutz
Hallo Rudi,
vielen Dank, das habe ich schon mal eingebaut - ist ja übersichtlicher.
Die Performance geht aber eben durch das 1 to 10000 runter...
Viele Grüße Lutz
AW: Ja, kann man! Ansonsten ist das, was du...
20.07.2011 16:13:14
Rudi
Hallo,
mal deutlich eingedampft:
Function Berechne(txt As String)
Dim i As Integer, j As Integer, strTmp As String
Dim arr1
arr1 = Array("+", "-", "/", "*")
txt = Application.Substitute(txt, " ", "")
txt = Application.Substitute(txt, ",", ".")
txt = Application.Substitute(txt, "x", "*")
txt = Application.Substitute(txt, "X", "*")
j = InStr(txt, "Ø")
If j > 0 Then
strTmp = Left(txt, j - 1)
j = j + 1
Do While IsNumeric(Mid(txt, j, 1))
j = j + 1
Loop
txt = strTmp & Mid(txt, j)
End If
strTmp = ""
For i = 1 To Len(txt)
If IsNumeric(Mid(txt, i, 1)) Then
strTmp = strTmp & Mid(txt, i, 1)
Else
Select Case Mid(txt, i, 1)
Case "*", "+", "-", "/": strTmp = strTmp & Mid(txt, i, 1)
End Select
End If
Next i
txt = strTmp
For i = 0 To UBound(arr1)
For j = 0 To UBound(arr1)
txt = Application.Substitute(txt, arr1(i) & arr1(j), arr1(i))
Next j
Next i
Berechne = Evaluate(txt)
End Function

Gruß
Rudi
Anzeige
AW: Ja, kann man! Ansonsten ist das, was du...
21.07.2011 11:44:54
lutz
Hallo Rudi, geht rasend schnell - super.
Leider bekomme ich ein paar falsche Ergebnisse - liegt irgendwie an dem Durchschnitt.
Hier mal die Beispieldatei:
https://www.herber.de/bbs/user/75793.xls
ist wahrscheinlich nur ein kleiner Fehler aber ich finde ihn nicht.
Vielen Dank und viele Grüße Lutz
AW: Ja, kann man! Ansonsten ist das, was du...
21.07.2011 12:52:17
Rudi
Hallo,
liegt irgendwie an dem Durchschnitt
Ja, deins ist ein Chr(248), meins ein Chr(216)
Außerdem wurden nur doppelte Operatoren eliminiert.
Function Berechne(txt As String)
Dim i As Integer, j As Integer, strTmp As String
Dim arr1
arr1 = Array("+", "-", "/", "*")
txt = Application.Substitute(txt, " ", "")
txt = Application.Substitute(txt, ",", ".")
txt = Application.Substitute(txt, "x", "*")
txt = Application.Substitute(txt, "X", "*")
txt = Application.Substitute(txt, "×", "*")
txt = Application.Substitute(txt, Chr(248), Chr(216))
j = InStr(txt, Chr(216))
If j > 0 Then
strTmp = Left(txt, j - 1)
j = j + 1
Do While IsNumeric(Mid(txt, j, 1))
j = j + 1
Loop
txt = strTmp & Mid(txt, j)
End If
strTmp = ""
For i = 1 To Len(txt)
If IsNumeric(Mid(txt, i, 1)) Then
strTmp = strTmp & Mid(txt, i, 1)
Else
Select Case Mid(txt, i, 1)
Case "*", "+", "-", "/", ".": strTmp = strTmp & Mid(txt, i, 1)
End Select
End If
Next i
txt = strTmp
Do
For i = 0 To UBound(arr1)
For j = 0 To UBound(arr1)
txt = Application.Substitute(txt, arr1(i) & arr1(j), arr1(i))
Next j
Next i
If strTmp = txt Then
Exit Do
Else
strTmp = txt
End If
Loop
Berechne = Evaluate(txt)
End Function

Gruß
Rudi
Anzeige
AW: Ja, kann man! Ansonsten ist das, was du...
21.07.2011 13:02:33
lutz
Hallo Rude,
das ist wirklich Super!!!
Ist um Längen schneller als meine Lösung und hat auch nicht die 10000 Beschränkung.
Vielen, vielen Dank und ich wünsche Dir noch einen besonders schönen Tag.
Viele Grüße Lutz
M.AW hast du wohl nicht grdlich durchgesehen,...
19.07.2011 22:56:59
Luc:-?
…sonst würde man wohl bestimmte Elemente davon in deiner Lösung wiederfinden (bspw Replace)!
Gruß Luc :-?
AW: M.AW hast du wohl nicht grdlich durchgesehen,...
19.07.2011 23:45:03
lutz
Hallo Luc,
hatte ich gesehen aber ich wußte eben nicht wie ich das einbauen sollte:(
Viele Grüße Lutz

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige