Registriert seit: 11.04.2014
Version(en): Office 2007
Hallo Michael,
bei meinen primitiven Tests mit deutlich kürzeren Strings (m100.17k2 und a 1.01n4) hat es funktioniert, jetzt sieht die Sache natürlich anders aus. Leider kann ich dir keine Lösung bieten. Zu der Formel von shift-del: Zeichne dir die Formel mit dem VBA-Rekorder auf, dann hast Du die VBA-Lösung.
Gruß Stefan
Win 10 / Office 2016
Registriert seit: 16.08.2017
Version(en): 2007 / 2010 / Web
Hi,
ohne weitere Hilfsspalten könnte es mit der Formel funktionieren.
Code: =GLÄTTEN(ERSETZEN(ERSETZEN(A1;FINDEN(".";A1)+3;0;" ");1/MAX(INDEX(ISTZAHL(1*(TEIL(A1;ZEILE($A$1:$A$23);1)))/ZEILE($A$1:$A$23);));0;" "))
Wie mann diese dann in ein funktionierendes Makro wandelt würde mich aber auch interessieren.
Registriert seit: 11.04.2014
Version(en): Office 2007
Hallo,
ich habe jetzt zum Beispiel die Formel von Elex in die Zelle B1 kopiert, geschaut, ob das Ergebnis auch so passt, wieder auf die Formelzelle geklickt, den Makrorekorder gestartet, die Zelle verlassen, den Rekorder beendet und in den VBA-Editor gewechselt. Hier fand ich folgendes Makro
Code: Sub Makro1()
'
' Makro1 Makro
'
'
ActiveCell.FormulaR1C1 = _
"=TRIM(REPLACE(REPLACE(RC[-1],FIND(""."",RC[-1])+3,0,"" ""),1/MAX(INDEX(ISNUMBER(1*(MID(RC[-1],ROW(R1C1:R23C1),1)))/ROW(R1C1:R23C1),)),0,"" ""))"
Range("B2").Select
End Sub
und dieses ein wenig überarbeitet um es etwas flexibler zu machen.
Code: Sub prcMichael()
Dim lngLastRow As Long
With Worksheets("Tabelle1")
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Cells(1, 2).Resize(lngLastRow).FormulaR1C1 = _
"=TRIM(REPLACE(REPLACE(RC[-1],FIND(""."",RC[-1])+3,0,"" ""),1/MAX(INDEX(ISNUMBER(1*(MID(RC[-1],ROW(R1C1:R" & lngLastRow _
& "C1),1)))/ROW(R1C1:R" & lngLastRow & "C1),)),0,"" ""))"
End With
End Sub
Gruß Stefan
Win 10 / Office 2016
Registriert seit: 06.12.2015
Version(en): 2016
Hallo,
eine Variante mit Autofill:
Code: Sub Elec()
F = "=TRIM(REPLACE(REPLACE(A1,FIND(""."",A1)+3,0,"" ""),1/MAX(INDEX(ISNUMBER(1*(MID(A1,ROW($A$1:$A$23),1)))/ROW($A$1:$A$23),)),0,"" ""))"
Cells(1, 3).Formula = F
Range("C1").AutoFill Range("C1:C4")
End Sub
mfg
Registriert seit: 16.08.2017
Version(en): 2007 / 2010 / Web
Hi
Danke für eure schnellen Antworten. Leider habe ich mich etwas unverständlich ausgedrückt. Ich möchte nicht meine Formel per Makro in die Zelle schreiben sondern das Ergebnis welches die Formel errechnet.
Gruß Elex
Registriert seit: 11.04.2014
Version(en): Office 2007
Hallo,
vielleicht mit Evaluate?
Code: Sub prcElex()
MsgBox Application.Evaluate("TRIM(REPLACE(REPLACE(A1,FIND(""."",A1)+3,0,"" ""),1/MAX(INDEX(ISNUMBER(1*(MID(A1,ROW($A$1:$A$18),1)))/ROW($A$1:$A$18),)),0,"" ""))")
End Sub
Gruß Stefan
Win 10 / Office 2016
Registriert seit: 16.08.2017
Version(en): 2007 / 2010 / Web
Hallo Michael,
Ich gebe dir auch noch ein VBA Code zum Probieren.
Im Test waren die Ergebnisse gleich den Ergebnissen aus den Excel-Formeln von shift-del und mir.
Über die Codegestalltung naja bin halt VBA Anfänger.
Code: Private Sub CommandButton1_Click()
Dim n As Byte
Dim j As Byte
Dim NeuA As String
Dim merker As Byte
Dim merker2 As Variant
For n = 1 To 8
merker = 0
merker2 = 200
For j = 1 To Len(Cells(n, 1))
If Mid(Cells(n, 1), j, 1) Like "#" Then
If merker = 0 Then
NeuA = NeuA & " "
merker = 1
End If
End If
If Mid(Cells(n, 1), j, 1) = "." Then merker2 = 3
If merker2 = 0 Then NeuA = NeuA & " "
If Mid(Cells(n, 1), j, 1) <> " " Then NeuA = NeuA & Mid(Cells(n, 1), j, 1)
merker2 = merker2 - 1
Next j
Cells(n, 2) = NeuA
NeuA = ""
Next n
End Sub
Der Versuch mit Application.Evaluate von Steffl klappt zwar, aber eben nur für A1. Habe keine Möglichkeit gefunden eine Schleife daraus zu machen.
Gruß Elex
Registriert seit: 11.04.2014
Version(en): Office 2007
Hallo,
(20.09.2017, 20:41)Elex schrieb: Der Versuch mit Application.Evaluate von Steffl klappt zwar, aber eben nur für A1. Habe keine Möglichkeit gefunden eine Schleife daraus zu machen.
vielleicht so?
Code: Sub prcElexneu()
Dim lngLastRow As Long, lngC As Long
With Worksheets("Tabelle1")
lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
For lngC = 1 To lngLastRow
MsgBox Application.Evaluate("TRIM(REPLACE(REPLACE(A" & lngC & ",FIND(""."",A" & lngC & ")+3,0,"" ""),1/MAX(INDEX(ISNUMBER(1*(MID(A" & _
lngC & ",ROW($A$1:$A$" & lngLastRow & "),1)))/ROW($A$1:$A$" & lngLastRow & "),)),0,"" ""))")
Next lngC
End Sub
Eine Anmerkung: Wenn Du Zellvariablen verwendest, solltest Du statt dem Variablentyp Byte eher den Variablentyp Long verwenden.
Gruß Stefan
Win 10 / Office 2016
Registriert seit: 14.04.2014
Version(en): 2007
Hallo!
Wollte mir gerade noch mal den Code von Fennek holen und sehe das noch richtig was los war.
Danke an alle für das intresse.
Werde jetzt mal alles durchtesten.
mfg
Michael
:98:
WIN 10 Office 2019
|