Vervolg op code HSV: sorteren

[jansm]

Heren, weer een probleem waarvan ik de oplossing van jullie hoop te krijgen. Het is een vervolg op een eerdere vraag van mij. Voor deze vraag gebruik ik een oplossing van HSV (en WHER/Snb).

Uitgangspunt is tabblad Test. De data van dit tabblad wordt gegenereerd door een code van HSV (knop hsv2!).
Kolom A bevat unieke persoonnummers van persoonsnamen in kolom E. In de rest van de kolommen staan andere persoonsgegevens. De lege cellen, bijv (A,12) en (A,13), in kolom A ontstaan doordat de code van HSV in (E,12) en (E,13) een alias van dezelfde persoon (E,11) plaatst. Tot zover loopt alles naar wens.
Nu de volgende stap waar ik de hulp van jullie weer nodig heb: ik wil graag sorteren op kolom E (achternaam) en dan op kolom F (voornaam).
Dat werkt niet met de optie sorteren. De aliassen die zijn toegevoegd komen dan uiteraard niet meer onder de persoon waar ze horen. Hoe is dit op te lossen? HSV, zou jij in jouw code op de regels van de aliassen iets toe kunnen voegen (waarde oid???) dat gebruikt kan worden bij het sorteren?
Bekijk bijlage Test2hsv.xlsb

 

[HSV]

In onderstaande code wordt blad 'Personen' eerst gesorteerd op E en F.
De code doet z'n werk wat het anders ook deed maar staat nu gesorteerd in tabblad 'Test'.
Daarna sorteer ik tabblad 'Personen' weer op kolom A voor oorspronkelijke staat.

Private Sub Commandbutton2_Click()
Dim sn, sp, arr, arr2
Dim i As Long, n As Long, j As Long, jj As Long, jjj As Long, jjjj As Long, a As Long
Dim Dic As Object
Dim id As String
Dim c As Range
Dim t As Single
t = Timer
Application.ScreenUpdating = False
 Set Dic = CreateObject("Scripting.Dictionary")
   
   With Sheets("personen")
     .Cells(1).CurrentRegion.Sort .[E1], , .[f1], , , , , 1
   End With
   sn = Sheets("personen").Cells(1).CurrentRegion
   sp = Sheets("feiten").Cells(1).CurrentRegion
      ReDim arr(1 To UBound(sn) + UBound(sp), 1 To UBound(sn, 2))
       n = UBound(sn) + UBound(sp)
        For i = UBound(sn) To 1 Step -1
         id = sn(i, 1) & "_" & sn(i, 9)
            If Not Dic.Exists(id) Then
                 Dic(id) = 0
                  For jj = UBound(sp) To 2 Step -1
                      If sn(i, 1) = sp(jj, 1) And sp(jj, 18) = "ALIAS" Then
                        n = n - 1
                        arr(n, 5) = sp(jj, 19)
                      End If
                    Next jj
                  n = n - 1
                 For j = 1 To UBound(arr, 2)
                   arr(n, j) = sn(i, j)
                 Next j
            End If
        Next i
   ReDim arr2(1 To UBound(arr), 1 To UBound(arr, 2))
    aa = UBound(arr) - n
    n = 0
   
  For jjj = UBound(arr) - aa To UBound(arr)
       n = n + 1
        For jjjj = 1 To UBound(arr, 2)
          nn = nn + 1
          arr2(n, nn) = arr(jjj, jjjj)
        Next jjjj
        nn = 0
      Next jjj
   Sheets("test").Cells(1).Resize(UBound(arr2), UBound(arr2, 2)) = arr2
   With Sheets("personen")
     .Cells(1).CurrentRegion.Sort .[A1], , , , , , , 1
   End With
   
   Debug.Print Format(Timer - t, "0.0000"), "hsv 2"
 Set Odic = Nothing
 Application.ScreenUpdating = True
End Sub

 

[jansm]

Harry, bedankt voor je snelle reactie. Ik heb nu geen tijd om het goed te bekijken en te testen. Doe ik morgen. Alvast erg bedankt.

 

[snb]

Door de aliassen niet, zoals het hoort in een correcte tabel, als aparte velden te hebben gedefinieerd bijv. alias_1, alies_2 etc. , maar de gegevens (vanuit tabeloogpunt) in aaprte lege records hebt gezet, heb je zelf dit probleem gecreëerd. In plaats van een elastiekjes/plakband 'oplossing' in VBA, zou ik het liever struktureel aanpakken door die aliasvelden toe te voegen en de tabel weer te maken zoals het hoort: 1 rij per record. Daarna is VBA overbodig om correct te sorteren.

 

[jansm]

Harry, hij doet het perfect, precies wat ik wil. Nogmaals dank!
@snb: wat jij voorstelt is nu precies wat ik NIET wil. Ik wil de persoonsnamen inclusief de aliassen in één oogopslag kunnen zien om te vergelijken. Dat kan niet als ze over kolommen zijn verdeeld. Nogmaals, zo is het voor mij perfect. Toch bedankt voor je inbreng.