AW: Zellen tauschen ganze Spalte
30.01.2017 13:28:13
Daniel
Hi
wenn du Formate mit tauschen willst, dann müsstest du mit .Copy Destination arbeiten, weil hierbei Inhalte und Formate kopiert werden.
Du musst aber die Inhalte einer Spalte zwischenspeichern.
die Schleife kannst du auch einfacher gestalten, da du mit STEP angeben kannst, dass nur jede zweite Zeile verwendet werden soll:
For Zeile = 3 to .Usedrange.rows.count Step 2
.Cells(Zeile, 1).Copy .Cells(Zeile, 5)
.Cells(Zeile, 3).Copy .Cells(Zeile, 1)
.Cells(Zeile, 5).Copy .Cells(Zeile, 3)
Next
.columns(5).Clear
bei großen Datenmengen könnte es schneller sein, wenn du nicht jede Zeile einzeln kopierst, sondern erstmal:
die Tabelle so sortierst, das alle Zeilen, die getauscht werden müssen direkt untereinander stehen.
dann den Tausch für den ganzen Zellblock in einem Schritt ausführst
jetzt die Zeilen wieder in die Ursprüngliche Reihenfolge zurücksortierst
die Ursprüngliche Reihenfolge sichert man sich in einer Hilfsspalte per formel: =Zeile() und ersetzt dann in dieser Hilfsspalte die Formeln durch Werte.
Ebenso kennzeichnet man jede zweite Zeile per Hilfsspalte, so dass man über Sortieren den Block bilden kann.
das sieht als Gesamtcode dann so aus:
Sub tausch()
With ActiveSheet.UsedRange
With .Columns(.Columns.Count + 1).Resize(, 2)
.Columns(1).FormulaR1C1 = "=Row()"
.Columns(2).FormulaR1C1 = "=If(Mod(Row(),2)=1,""x"",1)"
.Formula = .Value
.EntireRow.Sort key1:=.Cells(1, 2), order1:=xlAscending, Header:=xlYes
With .Offset(1, 0).SpecialCells(xlCellTypeConstants, 2)
.Offset(0, 1 - .Column).Copy .Offset(0, 1)
.Offset(0, 3 - .Column).Copy .Offset(0, 1 - .Column)
.Offset(0, 1).Copy .Offset(0, 3 - .Column)
.Offset(0, 1).Clear
End With
.EntireRow.Sort key1:=.Cells(1, 1), order1:=xlAscending, Header:=xlYes
.ClearContents
End With
End With
End Sub
wie gesagt, der Code ist etwas aufwendiger, dürfte bei größeren Datenmengen aber deutlich schneller sein.
Gruß Daniel