Microsoft Excel

Herbers Excel/VBA-Archiv

Spalten Sort by ÜSchrift - Array statt Zellbezug


Betrifft: Spalten Sort by ÜSchrift - Array statt Zellbezug
von: Thorben
Geschrieben am: 30.11.2018 14:47:02

Hallo zusammen,

mit folgenden vba sortiere ich spalten anhand einer Liste aus 2 Tabellen.
Das ist ja alles hart verdrahtet!

Könnt ihr mir daraus ein Array statt fixem Zellbezug machen,
sodas ich einen Bereich angegeben kann um flexibel zu sein
falls ich Kriterien dazupacke oder wegnehme.

Ich habs versucht, weiß aber nicht weiter.
Spalte 1 bis 6 kann so bleiben.
Es geht um die Spaten ab 7

Sub SpaltenSortieren()

Dim Spalte(1 To 49) As String
Dim i As Long

Spalte(1) = Sheets("Auslegen").Range("A1").Value
Spalte(2) = Sheets("Auslegen").Range("B1").Value
Spalte(3) = Sheets("Auslegen").Range("C1").Value
Spalte(4) = Sheets("Auslegen").Range("D1").Value
Spalte(5) = Sheets("Auslegen").Range("E1").Value
Spalte(6) = Sheets("Auslegen").Range("F1").Value
Spalte(7) = Sheets("Sort").Range("A1").Value
Spalte(8) = Sheets("Sort").Range("A2").Value
Spalte(9) = Sheets("Sort").Range("A3").Value
Spalte(10) = Sheets("Sort").Range("A4").Value
Spalte(11) = Sheets("Sort").Range("A5").Value
Spalte(12) = Sheets("Sort").Range("A6").Value
Spalte(13) = Sheets("Sort").Range("A7").Value
Spalte(14) = Sheets("Sort").Range("A8").Value
Spalte(15) = Sheets("Sort").Range("A9").Value
Spalte(16) = Sheets("Sort").Range("A10").Value
Spalte(17) = Sheets("Sort").Range("A11").Value
Spalte(18) = Sheets("Sort").Range("A12").Value
Spalte(19) = Sheets("Sort").Range("A13").Value
Spalte(20) = Sheets("Sort").Range("A14").Value
Spalte(21) = Sheets("Sort").Range("A15").Value
Spalte(22) = Sheets("Sort").Range("A16").Value
Spalte(23) = Sheets("Sort").Range("A17").Value
Spalte(24) = Sheets("Sort").Range("A18").Value
Spalte(25) = Sheets("Sort").Range("A19").Value
Spalte(26) = Sheets("Sort").Range("A20").Value
Spalte(27) = Sheets("Sort").Range("A21").Value
Spalte(28) = Sheets("Sort").Range("A22").Value
Spalte(29) = Sheets("Sort").Range("A23").Value
Spalte(30) = Sheets("Sort").Range("A24").Value
Spalte(31) = Sheets("Sort").Range("A25").Value
Spalte(32) = Sheets("Sort").Range("A26").Value
Spalte(33) = Sheets("Sort").Range("A27").Value
Spalte(34) = Sheets("Sort").Range("A28").Value
Spalte(35) = Sheets("Sort").Range("A29").Value
Spalte(36) = Sheets("Sort").Range("A30").Value
Spalte(37) = Sheets("Sort").Range("A31").Value
Spalte(38) = Sheets("Sort").Range("A32").Value
Spalte(39) = Sheets("Sort").Range("A33").Value
Spalte(40) = Sheets("Sort").Range("A34").Value
Spalte(41) = Sheets("Sort").Range("A35").Value
Spalte(42) = Sheets("Sort").Range("A36").Value
Spalte(43) = Sheets("Sort").Range("A37").Value
Spalte(44) = Sheets("Sort").Range("A38").Value
Spalte(45) = Sheets("Sort").Range("A39").Value
Spalte(46) = Sheets("Sort").Range("A40").Value
Spalte(47) = Sheets("Sort").Range("A41").Value
Spalte(48) = Sheets("Sort").Range("A42").Value
Spalte(49) = Sheets("Sort").Range("A43").Value

For i = 1 To UBound(Spalte)
    Rows(1).Replace Spalte(i), i, lookat:=xlWhole
    Next

ActiveSheet.UsedRange.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlNo, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlLeftToRight, _
        DataOption1:=xlSortNormal

For i = 1 To UBound(Spalte)
    Rows(1).Replace i, Spalte(i), lookat:=xlWhole
Next

End Sub

Danke BG
Thorben

  

Betrifft: AW: Spalten Sort by ÜSchrift - Array statt Zellbezug
von: fcs
Geschrieben am: 02.12.2018 09:24:45

Hallo Thorben,

deine Frage ist etwas unklar.

Was soll variabel sein?
Die Anzahl der Einträge in Spalte A von Blatt "Sort"?
D.h. mal Werte von A1:A52 das andere mal von A1:A57 ?

LG from China
Franz


  

Betrifft: Hab was gefunden, teile gerne :)
von: Thorben
Geschrieben am: 03.12.2018 08:48:39

Hallo Franz,

ja, so wie Du es beschrieben hast.
Also etwas wie
Dim i as Long
i = Sheets("Sort").Range("A1").Offset
For each i usw.

Es besteht keine Notwendigkeit mehr da ich etwas gefunden und nach meinen Bedürfnissen angepasst habe.

Ist schön flexibel einestzbar :)


  • Dim findfield As Variant
    Dim oCell As Range
    Dim iNum As Long
    Dim i As Long

    ReDim v(0 To 0)
    For i = 0 To 50
    ReDim Preserve v(0 To i)
    v(i) = Sheets("Sort").Range("A1").Offset(i)
    Next i

    For x = LBound(v) To UBound(v)
    findfield = v(x)
    iNum = iNum + 1
    Set oCell = ActiveSheet.Rows(1).Find(What:=findfield, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

    If Not oCell.Column = iNum Then
    Columns(oCell.Column).Cut
    Columns(iNum).Insert Shift:=xlToRight
    End If
    Next x


  • Gruß
    Thorben