gegevens anders sorteren

[Trmgroot]

Beste,

Ik heb nu een excelbestand waarbij allerlei persoonsgegegevens staan per rij.
Deze moeten anders gesorteerd worden: Per rij/scannummer moeten de persoonsgegevens achter elkaar opgenomen worden.

In de bijlage een voorbeeld zoals het nu (blad 2) is en hoe straks moet worden (blad 1).
Het lastige is dat de ene keer 5 personen bij een scan horen en een andere keer 2 personen.

Iemand die een handig tip heeft?
Ik maakte gebruik van een xml en misschien kan ik de gegevens ook anders importeren.

Vriendelijke groeten
Tamara

Bekijk bijlage voorbeeld.xlsx

 

[snb]

Gebruik:

Sub M_snb()
  sn = Sheet2.Cells(1).CurrentRegion
    
  With CreateObject("scripting.dictionary")
    For j = 2 To UBound(sn)
      c00 = Join(Application.Index(sn, j), "|")
      If .exists(sn(j, 1)) Then c00 = .Item(sn(j, 1)) & "|" & Replace(c00, sn(j, 1) & "|", "")
      .Item(sn(j, 1)) = c00
    Next
          
    For j = 0 To .Count - 1
      sp = Split(.Items()(j), "|")
      Sheet1.Cells(20 + j, 1).Resize(, UBound(sp) + 1) = sp
    Next
  End With
End Sub

PS. graag met dankplaquette in het WF-Museum

 

[Trmgroot]

Dat ziet er ingewikkeld uit. Ik bekijk het straks even.

Enne, bijna goed. Maar ik werk niet bij het museum, er komt dus geen plaquette. Is een bedankje op twitter ook goed?

 

[Trmgroot]

Hmmm... het is toch allemaal te nieuw voor mij.
Ik heb het ontwikkellaarslint aangezet, maar wat moet ik daarna doen om de code te laten functioneren?

 

[Trmgroot]

Ik zie nu ook dat ik tabbladen in het voorbeeld niet goed had gezet. Blad 2 is hoe het is en Blad 1 is hoe ik het graag wil hebben

 

[alphamax]

1. toets (linker)ALT+F11, de visual basic editor springt open
2. klik in de menubalk, invoegen-module, de module springt open
3. plak in code in de module
4. toets F5 op de code te laten lopen
5. kijk in blad1/straks

[SIZE=1]Sub M_snb()
  sn = Blad2.Cells(1).CurrentRegion
    
  With CreateObject("scripting.dictionary")
    For j = 2 To UBound(sn)
      c00 = Join(Application.Index(sn, j), "|")
      If .exists(sn(j, 1)) Then c00 = .Item(sn(j, 1)) & "|" & Replace(c00, sn(j, 1) & "|", "")
      .Item(sn(j, 1)) = c00
    Next
          
    For j = 0 To .Count - 1
      sp = Split(.Items()(j), "|")
      Blad1.Cells(20 + j, 1).Resize(, UBound(sp) + 1) = sp
    Next
  End With
End Sub[/SIZE]

 

[Trmgroot]

Ik ben hier heel erg mee geholpen. Hartelijk dank!