Office: Wert zwischen zwei Zeichen in andere Spalte

Ich müsste einen Zahlenwert, der zwischen zwei Zeichen in einer Spalte steht, eine Spalte weiter zu übertragen. Das Ganze Zeile für Zeile.
Ich habe versucht aus diversen Seiten Programmteile für ein Makro zusammenzubasteln, aber stoße an meine Grenzen. Kann mir da jemand helfen:


Sub WertZwischenZweiZeichen()

i = 1
While Cells(i, 1) ""


Dim SignEins, SignZwei As Integer
Dim Text As String

Text = Cells(i, 12)
SignEins = InStr(Text, "€")
SignZwei = InStr(Text, "_")

Cells(i, 13) = Mid(Text, SignEins + 1, (SignZwei - 1) - (SignEins + 1))


i = i + 1
Wend
End Sub

Die Ursprungstexte sehen in etwa so aus:
ABCD56E78€12_FGH
Ich müsste davon die 12 in die nächste Spalte bringen.

:)

 

ich hätte es ohne VBA gelöst.

Tabelle1

	A	B
2	ABCD56E78€12_FGH	12

verwendete Formeln
Zelle	Formel	Bereich	N/A
B2	=TEIL(A2;SUCHEN("€";A2)+1;SUCHEN("_";A2)-SUCHEN("€";A2)-1)*1

Excel-Inn.de

Hajo-Excel.de

XHTML-Tabelle zur Darstellung in Foren, einschl. der neuen Funktionen ab Version 2007

Add-In-Version 25.14 einschl. 64 Bit

 

Danke, aber Ich brauche arbeitstechnisch ein VBA dazu.

 

Du kannst doch Hajos Formel mittels VBA in die Spalte schreiben und .Value = .Value machen.
Läuft allemal flotter als Deine beabsichtigte Schleife mit Zellzugriffen.

Gruß Ralf

 

DeinBereich anpassen:
Code:

 

Das würde schon gehen.
Ich habe aber eine komplexe Tabelle in der ich laufend Zeilen einfügen, verschieben, weiterverlinken auch löschen usw. muss. Hier gibts dann Konflikte. Ausserdem müsste ich den Vorgang für viele (26) Tabellenseiten wöchentlich immer wieder neu machen.
Da ich sowieso einen VBA Durchlauf machen muss, wäre es auf diesem Weg eine große Erleichterung.

 

Mein letzter Beitrag war jetzt aber nicht chinesisch, oder?
War sogar fast pfannenfertig.
Gut, den Bereich musst Du anpassen, da ich ihn nicht kenne.

 

Hallo,

Ralf's löst die Aufgabe zwar gut, man kann es aber auch als UDF formulieren.

Als Beispiel wird ein Text in A1 geschreiben und per UDF die Zahl ausgelesen:

PHP:

         sub main
cells(1,1) = "Dphf€23,4_nrnc"
msgbox gesuchtezahl(cells(1,1))
end sub
function gesuchteZahl(Tx as string) as double
Tx = replace(Tx, ",",".")
gesuchteZahl =  split(split(Tx,"€")(1),"_")(0)
End function


 

Für mich ist das leider schon chinesisch, weil ich so selten damit zu tun habe.

Wenn ich deinen Teil so in meine Schleife einbaue (mein Bereich sei die 7te Spalte) - wie sage ich dem Programm, dass es den Wert in Spalte 8 einsetzen soll?



Sub Werteversuch003()

i = 1
While Cells(i, 1) ""

With Cells(i, 7)
.FormulaR1C1 = "=MID(RC1,SEARCH(""€"",RC1)+1,SEARCH(""_"",RC1)-SEARCH(""€"",RC1)-1)*1"
.Copy: .PasteSpecial xlPasteValues
End With

i = i + 1
Wend

End Sub

 

Ich habe es jetzt mal mit 10.000 Datensätzen probiert, Phi.
"Meine" Funktion ist doppelt so schnell wie Deine UDF.
(hat mich jetzt aber nicht verwundert, ich hätte die Differenz eher noch größer geschätzt)
Mein Testcode:

Man könnte jetzt nochmal mit einem Array testen, aber ich muss jetzt weg, REVIERDERBY!!!

Gruß Ralf

 

NEIN!!
Lass den Blödsinn mit der langsamen Schleife und bearbeite den Bereich im Block!

 

Ich habs jetzt gelöst.
Und falls hier irgendwann jemand mit dem gleichen Problem hier landet, ist das vielleicht eine Hilfe:

Sub ZweiZeichen()

Dim Text As String
Dim Euro As Variant



i = 1
While Cells(i, 1) ""

Text = Cells(i, 7)
pos1 = InStr(Text, "€") + 1 'Position erster Punkt
If pos1 > 1 Then Euro = Mid(Text, pos1) Else: Euro = ""
pos2 = InStr(Euro, "_") - 1
If pos2 > 0 Then Euro = Left(Euro, pos2)


Cells(i, 12) = Euro

i = i + 1
Wend
End Sub

 

Sub KickUrLegsUp() 'Kombination aus #8 und #12
n = [A65536].End(xlUp).Row 'einmalige Erledigung VOR DER Schleife, statt Exit For
a = [A1:A65535] 'gib Spalte A in ein Variantarray aus
For i = 1 to n
a(i, 1) = Split(Split(Replace(a(i, 1), ",", "."), "€")(1), "_")(0)
Next
[B1:B65535] = a 'gib das Variantarray in Spalte B aus
End Sub 'Ausführung ~0,8 Sekunden bei 65536 Einträgen

 

Danke Lupo1,
für deine Weiterverbesserung. Die freut mich. *Smilie