Gegevens indelen,Transponeren via VBA

[Abyss]

Hallo allemaal,

Ik heb jullie hulp nodig.

Ik krijg gegevens aangeleverd die ik graag handig en snel wil verwerken.

Ik heb een voorbeeld er bij gedaan. Met in tabblad 1 hoe ik de gegevens aangereikt krijg
En in tabblad twee hoe ik ze weer verstuur. Het kost me alleen veel tijd om het zo te krijgen
Dus mijn vraag of er een stukje VBA beschikbaar is, wat dit proces kan versnellen.


Abyss

 

[snb]

Sub tst()
  sq = Blad1.UsedRange
  ReDim sn(UBound(sq) * UBound(sq, 2) - 2, 4)
  sn(1, 1) = "veld"
  sn(1, 2) = "test"
  sn(1, 3) = "positie"
  sn(1, 4) = "box"
  jjj = 2
  For j = 2 To UBound(sq)
    For jj = 2 To UBound(sq, 2) - 1
      If sq(j, jj) <> "" Then
        sn(jjj, 1) = sq(j, 1)
        sn(jjj, 2) = sq(j, jj)
        sn(jjj, 3) = sq(j, UBound(sq, 2))
        sn(jjj, 4) = Asc(UCase(Left(sn(jjj, 3), 1))) - 64
      End If
    Next
    jjj = jjj + 1
  Next
  Blad2.Cells(1, 1).Resize(UBound(sn), UBound(sn, 2)) = sn
End Sub

 

[Abyss]

Sub tst()
  sq = Blad1.UsedRange
  ReDim sn(UBound(sq) * UBound(sq, 2) - 2, 4)
  sn(1, 1) = "veld"
  sn(1, 2) = "test"
  sn(1, 3) = "positie"
  sn(1, 4) = "box"
  jjj = 2
  For j = 2 To UBound(sq)
    For jj = 2 To UBound(sq, 2) - 1
      If sq(j, jj) <> "" Then
        sn(jjj, 1) = sq(j, 1)
        sn(jjj, 2) = sq(j, jj)
        sn(jjj, 3) = sq(j, UBound(sq, 2))
        sn(jjj, 4) = Asc(UCase(Left(sn(jjj, 3), 1))) - 64
      End If
    Next
    jjj = jjj + 1
  Next
  Blad2.Cells(1, 1).Resize(UBound(sn), UBound(sn, 2)) = sn
End Sub

Mooie code, maar hij levert niet het resultaat wat hij zou moeten leveren.
i.p.v
001 test1 A01
001 test2 A01
001 test3 A01
001 test4 A01

doet hij
1 test4 A01
2 test4 A02
3 test4 A03
4 test4 A04

Waarbij hij dus veld nummer 1 test 1,2,3 niet meeneemt

Hij levert dus niet wat ik ikn tab 2 als voorbeeld had neer gezet.

 

[snb]

Nou, dan zou ik zeggen: in de benen !, werk aan de winkel !!
En doe meteen iets aan die derde persoon enkelvoud (die immer op een t eindigt)

 

[Abyss]

Nou daar ben ik lekker mee

Bedank voor de hulp