rijen naar kolommen (NB : transponeren voldoet niet)

[PenningThor]

Ik heb een spreadsheet dat als volgt is samengesteld:

de eerste kolom bevat het lidmaatschapsnummer van een lid, de volgende vijf kolommen bevatten codes van taken die deze leden willen uitvoeren.

Voor de import in een database moeten deze kolommen als volgt worden omgevormd:

Slecht twee kolommen, in de eerste kolom staat vijf maal het lidmaatschapnummer (onder elkaar) en in de tweede kolom de vijf codes van de taken onder elkaar. Met transponeren lukt dit niet, ik ben ook bezig geweest met draaitabel maar dat biedt ook geen soelaas. Wie kan een helpende hand bieden?

 

[Cobbe]

Maar zonder bestand zal het niet veel helpen denk ik zo.

 

[PenningThor]

Vergeten

Sorry niet aan gedacht. Ik heb een voorbeeld bestand gemaakt. De komende week gaan vrijwilligers de ingeleverde formulieren verwerken in een spreadsheet. De meeste leden geven zich op voor twee à drie taken, maar sommige leden zijn breed inzetbaar.

Nadat de zes invoerkrachten klaar zijn voeg ik de bestanden samen en dan is de uitdaging om de gegevens zo te krijgen dat ze ingelezen kunnen worden in de database.

 

[Cobbe]

En waarom is een draaitabel niet goed genoeg?

 

[Timshel]

Voeg een werkblad "Blad2" in voor de uitvoer en draai onderstaande macro:

Sub tsh()
    Dim Br, Bs
    Dim i As Long, j As Long, k As Long
    
    Br = Sheets("Blad1").Cells(1).CurrentRegion
    ReDim Bs(UBound(Br) * UBound(Br, 2) - 1, 1)
    For i = 2 To UBound(Br)
        For j = 2 To UBound(Br, 2)
            If Br(i, j) = "" Then
                Exit For
            Else
                Bs(k, 0) = Br(i, 1)
                Bs(k, 1) = Br(i, j)
                k = k + 1
            End If
        Next
    Next
    Sheets("Blad2").Cells(2, 1).Resize(k, 2) = Bs
End Sub

 

[Excelbat]

Goedenavond,

Ik volg dit met belangstelling. Kan je deze uitleggen s.v.p.:

ReDim Bs(UBound(Br) * UBound(Br, 2) - 1, [COLOR="#FF0000"]1[/COLOR])

Je maakt hier een nieuwe array aan van 39 rijen en 10 kolommen. Ja toch?
Maar waarom dan die allerlaatste 1 ???

Greetz/Excelbat

 

[Timshel]

De nieuwe array bevat 39 * 10 rijen (inclusief index 0) en 2 kolommen (index 0 en index 1).
Overigens zie ik nu dat de array nogal ruim gedimensioneerd wordt. Maximaal nodig is:

ReDim Bs(Ubound(Br) * (Ubound(Br, 2) - 1) -1, 1)

Of nog efficiënter:

Sub tsh()
    Dim Br, Bs
    Dim i As Long, j As Long, k As Long
    
    With Sheets("Blad1").Cells(1).CurrentRegion
        Br = .Value
        ReDim Bs([COLOR="#FF0000"]Application.CountA(.Offset(1, 1)) - 1[/COLOR], 1)
        For i = 2 To UBound(Br)
            For j = 2 To UBound(Br, 2)
                If Br(i, j) = "" Then
                    Exit For
                Else
                    Bs(k, 0) = Br(i, 1)
                    Bs(k, 1) = Br(i, j)
                    k = k + 1
                End If
            Next
        Next
    End With
    Sheets("Blad2").Cells(2, 1).Resize(k, 2) = Bs
End Sub

 

[PenningThor]

Heren, ik ben hartstikke blij met de ondersteuning, alleen het gaat mijn excel-pet wel iets te boven. Het opnemen van een eenvoudig makro lukt mij nog, maar hier heb ik ook verdere ondersteuning nodig.

Waar plaats ik de tekst van Timshell zodat de makro "kan draaien". Moet dat bij "ontwikkelaars", Visual basic. De tekst kan ik hierin kopieren , maar dan houdt het even bij mij op.

 

[PenningThor]

Draai tabel (oplossing Cobbe)

Beste Cobbe,

De database is door een derde zo ingericht dat de import moet door middel van twee kolommen. Kolom 1 staan de lidmaatschapnummers. in kolom twee de taken die de leden willen uitvoeren. Iedere taak is dus aan één lid gekoppeld en één lid kan meerdere taken hebben

dus de output van de draaitabel voldoet daar niet aan

 

[Timshel]

Met ALT-F11 open je de VB-editor.
Voeg een nieuwe module en plak de programmacode. Als de naam van het werkblad in je bestand afwijkt van de code, moet je de code aldaar aanpassen: "Blad1" wordt dan de naam van het werkblad.
Sluit de editor af.
Druk ALT-F8, selecteer "tsh" en voer uit.

 

[PenningThor]

bedank!

Ik heb het zo uitgevoerd den het resultaat is precies wat ik nodig heb. Ik ga er vanuit dat dit makro ook werkt met een sheet van ongeveer 900 rijen.

Hartstikke bedankt voor je hulp en bijdrage. Onze vereniging en ik zijn er ontzettend blij mee.

Jos Smits,
penningmeester arsv THOR