Instr über mehrere verschiedene Zeichen
29.10.2007 23:00:00
Timo
nach langer langer Zeit habe ich Mal wieder mit VBA zu tun und stoße dabei auf ein Problem. Ich importiere mehrere Exceldateien in ein Tabellenblatt und möchte nun innerhalb diesem eine Umwandlung machen "Text in Spalten". Das soll allerdings nur bei einigen Zellen der Fall sein. Daher wollte ich eine Abfrage schreiben, anhand derer Excel überprüft, ob er den Text in Spalten umwandeln soll oder nicht. Das funktioniert soweit auch sehr gut, jedoch denke ich ist mein Weg sehr umständlich, zumal bei huínzufügen von neuen Werten das Makro immer unübersichtlicher wird. Daher meine Frage ob man das nicht auch eleganter lösen kann?
Vielen Dank für Eure Hilfe.
Hier mein Code:
Public Const Spalte = 7
Sub Makro1()
' Makro1 Makro
Dim daten As String
Cells(1, 1).Activate
letzte_Zeile = Range("A65536").End(xlUp).Row
For i = 6 To letzte_Zeile
daten = Cells(i, Spalte).Value
Text = InStr(1, daten, "L ")
If Text = 1 Then
Cells(i, Spalte).Select
test (i)
GoTo weiter
End If
Text = InStr(1, daten, "Fl ")
If Text = 1 Then
If InStr(1, daten, "Flach") > 0 Then GoTo weiter
Cells(i, Spalte).Select
test (i)
GoTo weiter
End If
Text = InStr(1, daten, "Bl ")
If Text = 1 Then
Cells(i, Spalte).Select
test (i)
GoTo weiter
End If
Text = InStr(1, daten, "Rohr ")
If Text = 1 Then
Cells(i, Spalte).Select
test (i)
GoTo weiter
End If
Text = InStr(1, daten, "U ")
If Text = 1 Then
Cells(i, Spalte).Select
test (i)
GoTo weiter
End If
Text = InStr(1, daten, "HEB ")
If Text = 1 Then
Cells(i, Spalte).Select
test (i)
GoTo weiter
End If
Text = InStr(1, daten, "IPE ")
If Text = 1 Then
Cells(i, Spalte).Select
test (i)
GoTo weiter
End If
Text = InStr(1, daten, "Boden ")
If Text = 1 Then
Cells(i, Spalte).Select
test (i)
GoTo weiter
End If
Text = InStr(1, daten, "Bd ")
If Text = 1 Then
Cells(i, Spalte).Select
test (i)
GoTo weiter
End If
weiter:
Next i
End Sub
Sub test(i)
Selection.TextToColumns Destination:=Cells(i, Spalte), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=True, Other:=True, OtherChar:= _
"x", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)) _
_
, TrailingMinusNumbers:=True
End Sub