Kolommen sorteren

Status
Niet open voor verdere reacties.
Nu we toch bezig zijn:

Code:
Sub M_snb()
  y = [Table1].Columns.Count
  
  With Cells(1, y + 2).Resize(, y)
    .Value = Split(Replace(Join(Filter(Split(Join(Filter(Application.Index(Application.Text(ListObjects(1).Range.Value, "@ @"), 1, 0), ""), "_"), "_"), " "), "|"), " ", "_"), "|")
    [Table1[#Headers]] = .Value
    .Sort .Resize(1, 1), , , , , , , , 2
    [Table1[#All]].AdvancedFilter 2, , .Offset(0)
  End With
End Sub
 
Laatst bewerkt:
Gaat mis in je Sort. Je mist twee komma's.
En nog steeds een extra tabel ipv vervanging van huidige tabel. Kolomheaders blijven ook omgedraaid.;)

Ter illustratie met een formule
Hier krijg je uiteraard ook een dubbele tabel

Code:
=LET(z;tbl_test[#All];r;INDEX(z;1;);s;TEXTAFTER(r;"_")&"_"&TEXTBEFORE(r;"_");INDEX(z;ROW(z);MATCH(SORTBY(r;s);r;0)))
 
Laatst bewerkt:
Mooi stukje dit @JEC. :thumb:
Code:
SORTBY(r;s)

Het principe van de array- en sortedlist.

Nu we dat weten kan het weer met een lusje minder.
Code:
Sub hsv_3()
Dim sv, x, e, Lo As ListObject, i As Long, xAp As Application, s0 As String
Set xAp = Application
Set Lo = Sheets(1).ListObjects(1)
 sv = Lo.Range.Value2
    For Each e In Lo.HeaderRowRange
       s0 = s0 & "|" & Split(e, "_")(1) & "_" & Split(e, "_")(0)
    Next
  x = xAp.SortBy(Lo.HeaderRowRange, Split(Mid(s0, 2), "|"))
  Lo.HeaderRowRange = x
  Lo.DataBodyRange = xAp.Index(sv, Evaluate("row(2:" & UBound(sv) & ")"), xAp.Match(x, xAp.Index(sv, 1), 0))
End Sub
 
Ik probeerde die laatste twee regels nog naar één regel te brengen, tevergeefs
 
Ook nog een manier gevonden met de codelijn van @snb.
Code:
Sub hsv_4()
Dim sv, sq, Lo As ListObject, xAp As Application
Set xAp = Application
Set Lo = Sheets(1).ListObjects(1)
  sv = Lo.Range.Value2
  sq = Split(Replace(Join(Filter(Split(Join(Filter(Application.Index(xAp.Text(Lo.HeaderRowRange.Value, "@ @"), 1, 0), ""), "_"), "_"), " "), "|"), " ", "_"), "|")
  Lo.HeaderRowRange = xAp.SortBy(Lo.HeaderRowRange, sq)
  Lo.DataBodyRange = xAp.Index(sv, Evaluate("row(2:" & UBound(sv) & ")"), xAp.Match(Lo.HeaderRowRange, xAp.Index(sv, 1), 0))
End Sub

Onoverzichtelijker zonder variabele sq, maar,......
Code:
Sub hsv_5()
Dim sv, sq, Lo As ListObject, xAp As Application
Set xAp = Application
Set Lo = Sheets(1).ListObjects(1)
  sv = Lo.Range.Value2
  Lo.HeaderRowRange = xAp.SortBy(Lo.HeaderRowRange, Split(Replace(Join(Filter(Split(Join(Filter(Application.Index(xAp.Text(Lo.HeaderRowRange.Value, "@ @"), 1, 0), ""), "_"), "_"), " "), "|"), " ", "_"), "|"))
  Lo.DataBodyRange = xAp.Index(sv, Evaluate("row(2:" & UBound(sv) & ")"), xAp.Match(Lo.HeaderRowRange, xAp.Index(sv, 1), 0))
End Sub
 
Laatst bewerkt:
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan