25.01.2018, 13:40
Tach leudde,
ich bräuchte einmal Hilfe mit diesem VBA-Code. Bisher sorgt dieser Code dafür, dass der Inhalt aus Zelle B3 ausgelesen wird, sodass die Teile zwischen "c" und "-" in separate Zellen daneben eingefügt werden. Die Teile zwischen "c" und "-" sind in der Form "0,5+0,35+0,6" oder "0,4+3*0,8" dabei sind da immer unterschiedlich viele Teile drin. Nun ist es leider so, dass der VBA-Code aber den Original text überschreibt und nicht direkt eine Zelle weiter nach rechts springt. Das wäre so die erste Frage wie der Code dafür angepasst werden müsste, damit Zelle B3 nicht überschrieben wird.
Und dann noch eine weitere Frage... das soll nicht nur auf Zelle B3 angewendet werden, sondern auf alle ausgefüllten Zellen die unter B3 kommen. Das bedeutet ich brauch ja irgendwie eine schleife, die solange ausgfeührt wird, solange die darunter kommenden Felder noch ausgefüllt sind.
Hat da wer ne Idee?
Hier mal mein jetziger Code:
Vielen Dank für die Hilfe und liebe Grüße!
ich bräuchte einmal Hilfe mit diesem VBA-Code. Bisher sorgt dieser Code dafür, dass der Inhalt aus Zelle B3 ausgelesen wird, sodass die Teile zwischen "c" und "-" in separate Zellen daneben eingefügt werden. Die Teile zwischen "c" und "-" sind in der Form "0,5+0,35+0,6" oder "0,4+3*0,8" dabei sind da immer unterschiedlich viele Teile drin. Nun ist es leider so, dass der VBA-Code aber den Original text überschreibt und nicht direkt eine Zelle weiter nach rechts springt. Das wäre so die erste Frage wie der Code dafür angepasst werden müsste, damit Zelle B3 nicht überschrieben wird.
Und dann noch eine weitere Frage... das soll nicht nur auf Zelle B3 angewendet werden, sondern auf alle ausgefüllten Zellen die unter B3 kommen. Das bedeutet ich brauch ja irgendwie eine schleife, die solange ausgfeührt wird, solange die darunter kommenden Felder noch ausgefüllt sind.
Hat da wer ne Idee?
Hier mal mein jetziger Code:
Code:
Option Explicit
Sub Baumdurchmesser-Übersicht()
Dim rngCell As Excel.Range
Dim blnErr As Boolean
Dim n As Long
'um diese Zelle geht's
Set rngCell = Worksheets("Tabelle1").Range("B3")
On Error GoTo Final
With rngCell
'reduziere den Zelleninhalt auf den Teil zwischen 'c' und '-'
.Value = Mid$(.Value, InStr(.Value, "c") + 1, InStr(.Value, "-") - InStr(.Value, "c") - 1)
'verw. Excel-Funktion: Daten -> TextInSpalten
Call .TextToColumns(rngCell, xlDelimited, Other:=True, OtherChar:="+")
End With
On Error GoTo 0 'Fehlerunterdrückung: AUS
'im folgenden wird solange Zelle um Zelle weiter nach rechts gesprungen
'bis jene Zelle keinen Inhalt mehr hat, dabei wird ggf. der Faktor vor '*' behandelt
Do
'schaue ob Zelle ein '*' beinhaltet
n = InStr(1, rngCell.Value, "*")
'als nächstes wird ggf. der Zelleninhalt zerlegt
'Inhalt Bsp: 3*0,5 wird zu: [n:=3] * [Ausdruck:=0,5]
'entsprechend zu n werden zustäzliche Zellen eingefügt und mit Ausdruck belegt
'(andere Daten werden dabei nach rechts verschoben)
If n > 0 Then
On Error Resume Next 'Fehlerunterdrückung: AN
n = Left(rngCell.Value, n - 1)
If Err.Number <> 0 Then
On Error GoTo 0 'Fehlerunterdrückung: AUS
blnErr = True
n = 1
ElseIf n > 1 Then
'Zelleninhalt um den Ausdruck 'n*' kürzen
rngCell.Value = Mid(rngCell.Value, InStr(1, rngCell.Value, "*") + 1)
rngCell.Value = rngCell.Value * 1 'versuche Zelleninhalt als Zahl zu formatieren
On Error GoTo 0 'Fehlerunterdrückung: AUS
'füge zusätzlichen Zellen ein
Call rngCell.Resize(, n - 1).Offset(, 1).Insert(xlShiftToRight)
rngCell.Resize(, n).Value = rngCell.Value 'kopiere Inhalt auf Zellen
End If
Else
n = 1
End If
'springe n Zellen nach rechts (damit werden die ggf. eingefügten Zellen mit übersprungen)
Set rngCell = rngCell.Offset(, n)
Loop While Trim$(rngCell.Value) <> ""
Final:
If Not blnErr Then
Call MsgBox("Vorgang abgeschlossen.", vbInformation)
Else
Call MsgBox("Vorgang mit Fehler(n) abgeschlossen." & vbNewLine & _
"Überprüfen sie das Ergebnis!", vbExclamation)
End If
End Sub
Vielen Dank für die Hilfe und liebe Grüße!