Macro voor meervoudig opsplitsen kolommen naar rijen

[nielsvo]

Ik heb de volgende uitdaging:
een input bestand met daarin meerdere rijen in een vaste kolomstructuur moet verdeeld worden naar een formaat waarbij de kolommen als ranges zijn verdeeld over meerdere rijen, voorafgegaan door een record id.

Bijvoorbeeld
____DOCUMENTKOP__ | ___ POSITIE___ | ___BEDRAG__
rij 1: Datum | Bedrijf | Document | Rekeningnummer | Bedrag
rij 2: idem
rij 3: idem

deze rijen moet worden verdeeld zodat het er uit komt te zien als:

rij 1: K | Datum | Bedrijf | Document
rij 2: P | Rekeningnummer
rij 3: B | Bedrag

K, P en B zijn record id's die aangeven wat de records voorstellen (vaste waardes).

Hoe kan ik dit makkelijk in een Excel macro oplossen?

 

[popipipo]

Een klein XLS voorbeeld bestandje helpt enorm.

 

[nielsvo]

Bij deze. De nummers in de P en B geven aan dat deze bedragen bij deze posities horen (relatie tussen P en B).

 

[Roncancio]

Bij deze. De nummers in de P en B geven aan dat deze bedragen bij deze posities horen (relatie tussen P en B).

Dit is een stuk duidelijker, maar hoe kom je aan de 1'en onder de datums in de D-kolom?

Met vriendelijke groet,


Roncancio

 

[nielsvo]

Dit is een stuk duidelijker, maar hoe kom je aan de 1'en onder de datums in de D-kolom?

Met vriendelijke groet,


Roncancio

De posities moeten opeenvolgend genummerd worden en de relatie tussen P(ositie) en B(edrag) ligt vast in deze teller.
Deel 2 van de uitdaging zit dan in het maken van een tegengestelde boeking (omdraaien bedrag op een ander rekeningnummer) voor elke positie.

Zie nieuwe voorbeeld.xls

Ik ben echt een leek op gebied van macro's

 

[Marcel79]

En die tegengestelde boeking, die is altijd op rekening 9999?

 

[nielsvo]

En die tegengestelde boeking, die is altijd op rekening 9999?

Ja, die kan dan als constante worden gedefinieerd.

 

[Marcel79]

Of het efficient is, is een geheel andere vraag:

Option Explicit

Sub VanRijenNaarKolommen()
Dim lRecord As Long
Dim lRijen As Long      'variabele voor aantal rijen
Dim wsInput As Worksheet
Dim wsOutput As Worksheet

Set wsInput = Worksheets("Blad1")   'vervangen door naam input-sheet
Set wsOutput = Worksheets("Blad2")  'idem, output-sheet

lRijen = wsInput.Range("C65536").End(xlUp).Row
    'zoekt laatste cel met inhoud in kolom C om het aantal rijen met inhoud te bepalen.
    
For lRecord = 2 To lRijen       'loopt alle rijen met inhoud langs, begint op rij 2
    wsOutput.Range("C" & (lRecord - 2) * 5 + 2).Value = "K"
            'plaatst K in cel C2 op Outputsheet
    wsOutput.Range("D" & (lRecord - 2) * 5 + 2).Value = wsInput.Range("C" & lRecord).Value
            'plaatst datum in cel D2
    wsOutput.Range("E" & (lRecord - 2) * 5 + 2).Value = wsInput.Range("D" & lRecord).Value
            'plaatst Bedrijfnr in E2
    wsOutput.Range("F" & (lRecord - 2) * 5 + 2).Value = wsInput.Range("E" & lRecord).Value
            'plaatst Documentnr in F2
    
    wsOutput.Range("C" & (lRecord - 2) * 5 + 3).Value = "P"
    wsOutput.Range("D" & (lRecord - 2) * 5 + 3).Value = 1
    wsOutput.Range("E" & (lRecord - 2) * 5 + 3).Value = wsInput.Range("F" & lRecord).Value
            'P, 1, rekeningnr in C3, D3 en E3
            
    wsOutput.Range("C" & (lRecord - 2) * 5 + 4).Value = "P"
    wsOutput.Range("D" & (lRecord - 2) * 5 + 4).Value = 2
    wsOutput.Range("E" & (lRecord - 2) * 5 + 4).Value = 9999
    
    wsOutput.Range("C" & (lRecord - 2) * 5 + 5).Value = "B"
    wsOutput.Range("D" & (lRecord - 2) * 5 + 5).Value = 1
    wsOutput.Range("E" & (lRecord - 2) * 5 + 5).Value = wsInput.Range("G" & lRecord).Value
            'bedrag
    
    wsOutput.Range("C" & (lRecord - 2) * 5 + 6).Value = "B"
    wsOutput.Range("D" & (lRecord - 2) * 5 + 6).Value = 2
    wsOutput.Range("E" & (lRecord - 2) * 5 + 6).Value = wsInput.Range("G" & lRecord).Value * -1
    
            
Next lRecord

End Sub

Ter verduidelijking: Ik laat dingen op het Output-sheet neerzetten o.b.v. een schijnbaar ingewikkelde rekensom, maar die zorgt ervoor dat de eerste record rij 2 t/m 6 pakt, de tweede record rij 7 t/m 11, etc.


Ik hoop dat je hier mee uit de voeten kan, groeten, Marcel

 

[nielsvo]

SUPER!!! :thumb:

Misschien niet efficient (daar heb ik verder geen verstand van) maar het is nu wel zodanig geschreven dat zelfs ik als leek dit kan begrijpen

Bedankt voor de snelle reactie(s)!

Niels

 

[Warme bakkertje]

Iets compacter

Sub tst()
c0 = ("K|P|P|B|B")
c1 = ("1|2|1|2")
For Each cl In Sheets("Blad1").Range("C2:C" & Sheets("Blad1").Cells(Rows.Count, 3).End(xlUp).Row)
With Sheets("Blad2")
    .[C65536].End(xlUp).Offset(1).Resize(5) = WorksheetFunction.Transpose(Split(c0, "|"))
    .[D65536].End(xlUp).Offset(1).Resize(, 3) = cl.Resize(, 3).Value
    .[D65536].End(xlUp).Offset(1).Resize(4) = WorksheetFunction.Transpose(Split(c1, "|"))
    With .[E65536]
        .End(xlUp).Offset(1) = cl.Offset(, 3).Value
        .End(xlUp).Offset(1) = 9999
        .End(xlUp).Offset(1) = cl.Offset(, 4).Value
        .End(xlUp).Offset(1) = cl.Offset(, 4).Value * -1
    End With
End With
Next
End Sub

 

[Ginger]

@Rudi, dan de volgende uitdaging... Waarom nog steeds een intreractie met de sheet? Prop je data in een array die je uiteindelijk in 1 keer wegschrijft naar de sheet.

Groet, Leo