Hallo zusammen,
habe einen Bericht, bei dem sich manchmal die Anordnung der Spalten ändert, wenn man ihn exportiert (Spaltenbezeichnungen bleiben immer gleich). Das Makro, mit dem ich dann die Datei bearbeite, funktioniert dann nicht mehr. Daher möchte ich die exportierte Datei immer in einer bestimmten Weise sortieren. Meine Lösung ist jetzt:
Sub verschieben()
Dim i As Single
Range(„A:H“).EntireColumn.Insert
For i = 9 To 16
If Cells(1, i) = „Kundengruppe“ Then
Columns(i).Cut
Columns(1).Select
Selection.Insert
End If
Next
For i = 9 To 16
If Cells(1, i) = „Sparte“ Then
Columns(i).Cut
Columns(2).Select
Selection.Insert
End If
Next
For i = 9 To 16
If Cells(1, i) = „Werk“ Then…
Nun hab ich halt 8 mal den FOR/NEXT Befehl, der die Überschrift sucht und dann nach einander einfügt.
Funktioniert alles, aber geht das auch irgendwie kompakter?
MfG
Hallo zusammen,
For i = 9 To 16
If Cells(1, i) = „Kundengruppe“ Then
Columns(i).Cut
Columns(1).Select
Selection.Insert
End If
Next
For i = 9 To 16
If Cells(1, i) = „Sparte“ Then
Columns(i).Cut
Columns(2).Select
Selection.Insert
End If
Next
For i = 9 To 16
If Cells(1, i) = „Werk“ Then…
Nun hab ich halt 8 mal den FOR/NEXT Befehl, der die
Überschrift sucht und dann nach einander einfügt.
Funktioniert alles, aber geht das auch irgendwie kompakter?
Klar:
For i = 9 To 16
Inhalt = Cells(1, i).Value
Select Case Inhalt
Case "Kundengruppe"
Spalte = 1
Case "Sparte"
Spalte = 2
Case "Werk"
Spalte = 3
'Case ...
'...
'Case Else
'...
End Select
Columns(i).Cut
Columns(Spalte).Select
Selection.Insert
Next
So müsste das funktionieren; ist aber ungeprüft
LG Tobi@s
Hallo Brille1982
Geprüfte Version:
Sub SpaltenSortieren()
Dim i As Integer, sp As Integer
For i = 9 To 16
Select Case Cells(1, i)
Case „Kundengruppe“
sp = 1
Case „Sparte“
sp = 2
Case „Werk“
sp = 3
’ usw.
Case Else
sp = 0
End Select
If sp > 0 Then
Columns(i).Cut
Columns(sp).Select
Selection.Insert
End If
Next
End Sub
Schöne Grüße
Roland
Hallo Brille,
wieso hast du eigentlich Single benutzt für das kleine i?
auch’n Versuch:
Sub Ordnen()
Dim Spa As Long, arrTitel
arrTitel = Array("Kundengruppe", "Sparte", "Werk") \*noch 5 dazu!
For Spa = 1 To 8
Columns(Application.Match(arrTitel(Spa - 1), Rows(1), 0)).Copy Cells(1, Spa + 8)
Next Spa
Range("A:H").ClearContents
End Sub
Gruß
Reinhard
Grüezi zusammen
Ich habe auch noch eine interessante Variante beizusteuern - einfach noch die fehlenden Spaltenüberschriften ergänzen:
Sub tr\_Verschieben()
Dim arrTitel As Variant
Dim arrIndex() As Integer
Dim i As Long
'Array beliebig mit Wrten auffüllen, in der gewünschten Reihenfolge
arrTitel = Array("Kundengruppe", "Sparte", "Werk")
'Index-Array redimensionieren
ReDim arrIndex(UBound(arrTitel))
'Index-Reihenfolge festlegen
For i = 0 To UBound(arrTitel)
arrIndex(i) = Range("1:1").Find(arrTitel(i), Range("A1"), , xlWhole).Column
Next i
'Spalten sortieren... :wink:
With ActiveSheet.UsedRange
.Value = Application.Index(.Value, .Worksheet.Evaluate("ROW(" & .Columns(1).Address & ")"), arrIndex())
End With
End Sub
Ach ja, die Daten sollten in A1 beginnen…
Mit freundlichen Grüssen
Thomas Ramel
Danke!
Hallo zusammen,
danke für die Vorschläge, werd ich heute mal ausprobieren!
MfG