AW: Zellinhalte Zahlen und Text extrahieren
29.09.2008 13:49:37
fcs
Hallo Markus,
nachfolgende Prozeduren bereiten den den text in den Zellen entsprechend auf.
Die erste Prozedur muss du ann einem Command-Button aus der Symbolleiste "Formular" zuweisen
Gruß
Franz
Private Zeile As Long, wks As Worksheet
Sub TextAufloesen()
Set wks = ActiveSheet
With wks
'altdaten löschen
Zeile = 24
.Range(.Cells(Zeile, 2), .Cells(Zeile, 2).End(xlDown).Offset(0, 1)).ClearContents
'1. Text auflösen
Call textaufbereiten(.Range("K10").Value)
'2. Text auflösen
Call textaufbereiten(.Range("N10").Value)
End With
End Sub
Sub textaufbereiten(strText As String)
Dim strZeile As String, intZeichen As Integer, Pos1 As Integer, Pos2 As Integer
If strText "" Then
For intZeichen = 1 To Len(strText)
strZeile = ""
'Text einer Zeile einlesen
Do Until Mid(strText, intZeichen, 1) = Chr(10)
strZeile = strZeile & Mid(strText, intZeichen, 1)
intZeichen = intZeichen + 1
If intZeichen = Len(strText) Then Exit Do
Loop
If strZeile "" Then
'Position 1. Leerzeichen
Pos1 = InStr(1, strZeile, " ")
'Menge auslesen
wks.Cells(Zeile, 3) = CDbl(Left(strZeile, Pos1 - 1))
'Position 2. Leerzeichen
Pos1 = InStr(Pos1 + 1, strZeile, " ")
'Position " ("
Pos2 = InStr(Pos1 + 1, strZeile, " (")
If Pos2 = 0 Then Pos2 = Len(strZeile) + 1
'Stoff auslesen
wks.Cells(Zeile, 2) = Mid(strZeile, Pos1 + 1, Pos2 - Pos1 - 1)
Zeile = Zeile + 1
End If
Next
End If
End Sub