Sorteren op 2 cellen

[tepke]

Hoi beste gebruikers

ik heb een vraag over sorteren, ik heb een vba scriptje geschreven en ik wil daar nog een sortering in aanbrengen.

ik heb bv de volgende gegevens
ordernummer Percentage
IC152345 10
IC152355 7
IK150456 5
IK150123 10

Ik wil 2 sorteringen eerste op de eerste 2 letters van het ordernummer (bv IC) en dan op het percentage. ik wil alle IC en IK orders gesorteerd hebben en gesorteerd op percentage.
Ik kan eerst twee characters van kolom ordernummer isoleren en dan de sorteer functie maken. dit is geen probleem voor me. maar ik vraag mij af of er ook een functie is die dat kan, dan hoef ik geen kolom bij te maken?
alvast bedankt marc

 

[HSV]

Hoi,

Met zoiets.

Cells(1).CurrentRegion.Sort [a1], , [b1], , , , , 1

 

[VenA]

Wel met een tijdelijke hulpkolom

Sub VenA()
With Sheets(1)
    ar = .Cells(1).CurrentRegion
    For j = 2 To UBound(ar)
        c00 = c00 & Left(ar(j, 1), 2) & "|"
    Next j
    .Columns(1).Insert
    .[A2].Resize(UBound(ar) - 1) = Application.Transpose(Split(c00, "|"))
    .Cells(1).CurrentRegion.Sort [a1], , [c1], , , , , 1
    .Columns(1).Delete
End With
End Sub

 

[HSV]

Zo moest het dus worden VenA. :thumb:
Mooie code.

In mijn haastigheid (vrouwlief zat te dringen ) niet goed gelezen blijkt.

Hier nog maar eentje zonder hulpkolom.

Sub hsv()
Dim arr, i As Long, j As Long, tmp
With Sheets(1)
   .Cells(1).CurrentRegion.Sort [a1], , , , , , , 1
sn = .Cells(1).CurrentRegion
ReDim arr(UBound(sn), 2)
 For i = 1 To UBound(sn)
   arr(i - 1, 0) = Left(sn(i, 1), 2)
   arr(i - 1, 1) = sn(i, 1)
   arr(i - 1, 2) = sn(i, 2)
 Next i
 For i = 1 To UBound(arr) - 1
    For j = i + 1 To UBound(arr)
      If arr(i, 0) >= arr(j, 0) Then
         If arr(i, 0) = arr(j, 0) And arr(i, 2) > arr(j, 2) Then
            tmp = arr(j, 0) & "|" & arr(j, 1) & "|" & arr(j, 2) & "|"
            arr(j, 0) = arr(i, 0)
            arr(j, 1) = arr(i, 1)
            arr(j, 2) = arr(i, 2)
            arr(i, 0) = Split(tmp, "|")(0)
            arr(i, 1) = Split(tmp, "|")(1)
            arr(i, 2) = Split(tmp, "|")(2)
          End If
      End If
    Next j
  Next i
   For i = 0 To UBound(arr)
      arr(i, 0) = arr(i, 1)
      arr(i, 1) = arr(i, 2)
    Next i
 .Cells(1, 13).Resize(UBound(sn), 2) = arr
 End With
End Sub

 

[VenA]

(vrouwlief zat te dringen )

bij pas vanaf 2 uur

Ik wist wel dat het sorteren van een array wel mogelijk is, maar dat dit redelijk complex is. Als ik jouw code bekijk denk ik te snappen wat het doet. Maar zal nog vaak op <F8> moeten drukken om het echt te begrijpen.:d

bv

arr(i, 0) = Split(tmp, "|")(0)

ken(de) ik niet. Dus ook een:thumb: voor wat leesvoer.

 

[HSV]

Code iets gewijzigd; Sorteren vooraf op kolom A is wel gewenst.

 

[HSV]

Ik kon het niet laten om het volledig te laten sorteren door de code ipv. eerst op het blad.

Sub hsv()
Dim sn, arr, i As Long, j As Long, tmp
With Sheets(1)
sn = .Cells(1).CurrentRegion
ReDim arr(UBound(sn), 2)
 For i = 1 To UBound(sn)
   arr(i - 1, 0) = Left(sn(i, 1), 2)
   arr(i - 1, 1) = sn(i, 1)
   arr(i - 1, 2) = sn(i, 2)
 Next i
 For i = 1 To UBound(arr) - 1
    For j = i + 1 To UBound(arr) - 1
       If arr(i, 0) >= arr(j, 0) Then
         If arr(i, 0) > arr(j, 0) Or CLng(arr(i, 2)) >= CLng(arr(j, 2)) Then
            tmp = arr(j, 0) & "|" & arr(j, 1) & "|" & arr(j, 2) & "|"
            arr(j, 0) = arr(i, 0)
            arr(j, 1) = arr(i, 1)
            arr(j, 2) = arr(i, 2)
            arr(i, 0) = Split(tmp, "|")(0)
            arr(i, 1) = Split(tmp, "|")(1)
            arr(i, 2) = Split(tmp, "|")(2)
          End If
      End If
    Next j
  Next i
   For i = 0 To UBound(arr)
      arr(i, 0) = arr(i, 1)
      arr(i, 1) = arr(i, 2)
    Next i
 .Cells(1, 13).Resize(UBound(sn), 2) = arr
 End With
End Sub