Sortieren von daten

Hallo
Das funktioniert auch nicht, wenn du mit dem Assistenten arbeitest.
Es geht nur wenn die Zelle einzeln angewählt ist, dann erkennt er alles
Hier ein abgewandelte Form die läuft:

Option Explicit
Sub Replace_and_Place_Filename()
Dim i As Long, n As Long, k As Long
Dim maxC As Byte, currC As Byte
'Backslash ersetzen
Columns("A:A").Select
Selection.Replace What:="\", Replacement:=" ", LookAt:=xlPart
'Spaltentext aufteilen
'Blöde Sache, manchmal werden bei Spaltenselectionen
'einzelne Leerzeichen nicht erkannt
'deshalb die Schleife um jede Zelle einzeln anzusprechen
'dann geht es
For i = 1 To Cells(65536, 1).End(xlUp).Row
    Cells(i, 1).TextToColumns Destination:=Cells(i, 1), Space:=True
Next i
'Erste Spalte löschen
Columns("A:A").Delete
'Maximale Spaltenanzahl bestimmen
maxC = ActiveSheet.UsedRange.Columns.Count
'Schleife um die Leerzellen zu einzufügen
For i = 1 To Cells(65536, 1).End(xlUp).Row
    currC = Cells(i, 255).End(xlToLeft).Column
    If currC < maxC Then
        For n = currC To maxC - 1
            Cells(i, n).Insert Shift:=xlToRight
        Next n
    End If
Next i
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

Gruss Rainer

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Karl
die Texte mit Slash usw. stehen in Spalte A.
Dann einfach mal dieses Makro laufen lassen :-))

Option Explicit
Sub Replace_and_Place_Filename()
Dim i As Long, n As Long, k As Long
Dim maxC As Byte, currC As Byte
'Backslash ersetzen
Columns("A:A").Select
Selection.Replace What:="\", Replacement:=" ", LookAt:=xlPart
'Spaltentext aufteilen
Selection.TextToColumns Destination:=Range("A1"), Space:=True
'Erste Spalte löschen
Columns("A:A").Delete
'Maximale Spaltenanzahl bestimmen
maxC = ActiveSheet.UsedRange.Columns.Count
'Schleife um die Leerzellen zu einzufügen
For i = 1 To Cells(65536, 1).End(xlUp).Row
    currC = Cells(i, 255).End(xlToLeft).Column
    If currC < maxC Then
        For n = currC To maxC - 1
            Cells(i, n).Insert Shift:=xlToRight
        Next n
    End If
Next i
End Sub

Code eingefügt mit Syntaxhighlighter 2.5

Vorher

Sub Letzte_Zelle() Dim cell_1 As Range Sheets("Tabelle1").Range("F1").Activate For Each cell_1 In Range("F1:F10") If cell_1.Value = "" Then cell_1.Value = cell_1.Offset(0, -2).Value cell_1.Offset(0, -2).Clear End If Next End Sub

Beliebteste Forumthreads (12 Monate)

13 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

13
Beiträge zum Forumthread

Beiträge zu diesem Forumthread