Bereik met 2 kolommen transponeren in bepaalde volgorde

Status
Niet open voor verdere reacties.

Boboes

Gebruiker
Lid geworden
5 nov 2016
Berichten
45
Zie bijgaand bestandje. In bereik C4 tot D18 kunnen steeds 1 tot 15 rijen gevuld zijn (dus variabel). Hoe kan met VBA geregeld dat het gevulde bereik getransponeerd wordt op de manier zoals het voorbeeld rechts van het bereik laat zien: dus op één rij eerst de code van het 1e record, dan de naam van het 1e record, vervolgens de code van het 2e record, dan de naam van het 2e record etc.

Het principe maakt onderdeel uit van een groter geheel van inlezen bestanden, maar op dit punt loop ik vast. Met gewoon transponeren lukt het niet vanwege de 2 kolommen en de volgorde. Ik heb wat geprobeerd met index-functie maar daar kwam ik niet uit.

Bedankt voor de hulp.
Christ
 

Bijlagen

  • Voorbeeld transponeren.xlsx
    9,3 KB · Weergaven: 28
zo?
Code:
Sub SjonR()
arr = Range("C4:D18")
ReDim arr2(1, UBound(arr) * 2) As String
    For i = 1 To UBound(arr)
        For j = 1 To 2
            arr2(0, n) = arr(i, j)
            n = n + 1
        Next
    Next
Cells(4, 6).Resize(, UBound(arr) * 2) = arr2
End Sub
 
Of:
Code:
Sub hsv()
Dim sv, i As Long, j As Long, n As Long
sv = Cells(3, 2).CurrentRegion
ReDim sq(1, UBound(sv) * 2)
For i = 2 To UBound(sv)
 If sv(i, 2) =  "" Then exit for
   For j = UBound(sv, 2) To 2 Step -1
      sq(0, n) = sv(1, j) & " " & sv(i, 1)
      sq(1, n) = sv(i, j)
      n = n + 1
  Next j
Next i
Cells(10, 6).Resize(2, n) = sq  'cells(4,6) voor de juiste plaats.
End Sub
 
Laatst bewerkt:
of
Code:
Sub VenA()
  ar = Cells(3, 2).CurrentRegion.Offset(1, 1).SpecialCells(2)
  For j = 1 To UBound(ar)
    c00 = c00 & "|" & ar(j, 2) & "|" & ar(j, 1)
  Next j
  Cells(6, 6).Resize(1, (j - 1) * 2) = Split(Mid(c00, 2), "|")
End Sub
 
of
Code:
Sub M_snb()
  With CreateObject("ADODB.Recordset")
    .Open "SELECT  code , naam FROM `Blad1$`", "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0""", 3
    Cells(6, 5).Resize(, .RecordCount) = Split(.GetString(, , ";", ";"), ";")
  End With
End Sub

NB. Verwijder natuurlijk wel eerst die bovenste zinloze lege rijen.
 
Laatst bewerkt:
Allereerst mijn oprechte excuses voor de late reactie, vanwege familieomstandigheden heb ik helaas niet eerder kunnen reageren. Ik wil jullie allemaal danken voor het meedenken. Ik kan zeker wel iets met de aangeboden (verschillende) oplossingen. Nogmaals excuses en bedankt!

M.v.gr.
Christ
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan