in Spalten aufteilen und Klammer weg
21.09.2006 20:57:06
Wolfgang
ich hoffe, dass ich mit dieser Anfrage nicht irgendwelche Regeln des Forums verletzte. Den nachstehenden Code hatte mir Josef Ehrensberger bereits soweit aufbereitet und umgestellt. Er bewirkt, dass Daten aus der Zwischenablage in ein verstecktes Tabellenblatt "Aufruf" kopiert werden. Die Daten werden aus einer Textdatei oder aus einem anderen Tabellenblatt mit rechter Maustaste in die Zwischenablage kopiert und über Schaltfläche auf einer UF in das Tabellenblatt kopiert. Das funktioniert auch soweit. Leider funktioniert noch nicht das Aufteilen auf Spalten und das Entfernen der Klammer. Die Daten sehen immer wie folgt aus, z.B. Elke Musterfrau (123456) - in Klammern steht eine Lieferantennummer. Die Aufteilung könnte z.B. sein, in Spalte A2 Vorname, B2 Name und C2 Lieferantennummer (ohne Klammer); Irgendwie hatte das schon geklappt, aber es steckt noch weiterhin der Wurm darin. Kann mir da evtl. jemand weiterhelfen?; Danke schon jetzt Allen für die Unterstützung, an dieser Stelle auch an Josef, der schon vieles aufbereitet hat und mir, als Anfänger, wichtige Hinweise gegeben hat.
Herzliche Grüße
Wolfgang
Sub ZwA()
With Sheets("Aufruf")
.Range("C4").PasteSpecial
.PasteSpecial Format:="Text"
Application.CutCopyMode = False
With .Range("C4")
With .Characters(Start:=1, Length:=28).Font
.Name = "Arial"
.FontStyle = "Standard"
.Size = 10
.ColorIndex = 1
End With
'Klammer oder sonstige Zeichen, Wörter entfernen
'Buchstabenfolge bzw. Wörter werden in Zellen aufgeteilt
.TextToColumns Destination:=.Range("A7"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:=" ", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _
TrailingMinusNumbers:=True
End With
With .Columns("C:C")
.Replace What:="(", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
.Replace What:=")", Replacement:=""
End With
End With
End Sub