Rij maken van meerdere records

[MichielM80]

Allen,

Ik heb een xls-bestand dat er ongeveer als volgt uitziet:

Kolom A Kolom B Kolom C
200 Kozijnen 01-01-2009
200 Muren 01-01-2010
200 Vensters 06-06-2009
200 Buiten 01-07-2010
200 Gevel 01-09-2009

En dat moet worden:

200 Kozijnen 01-01-2009 Muren 01-01-2010 Vensters 06-06-2009 Buiten 01-07-2010 Gevel 01-09-2009

Dus 1x kolom A als begin van de rij en daarna de gegevens uit B dan C en dan weer B en C etc.

Wie o wie heeft een manier om dit in excel automatisch voor elkaar te krijgen?

 

[Roncancio]

Bijv.:

Sub Samenstellen()
Dim lRij As Long
    lRij = 1
    While Range("A" & lRij).Value <> ""
        Cells(1, lRij).Value = Range("A" & lRij).Value & Space(1) & Range("B" & lRij).Value & Space(1) & Range("C" & lRij).Value
        lRij = lRij + 1
    Wend
End Sub

Met vriendelijke groet,


Roncancio

 

[MichielM80]

En hoe kan ik dat invoegen?

 

[Roncancio]

En hoe kan ik dat invoegen?

Ga naar Extra - Macro - Visual Basic Editor.
Ga naar Invoegen - Module.
Kopieer daar de code van de macro in.

De macro kan je vanuit Excel selecteren via Extra - Macro - Macro's.

Met vriendelijke groet,


Roncancio

 

[MichielM80]

Tot zover bedankt Roncancio.

Maar het is nog niet helemaal zoals ik voor ogen heb.

Wat ik wil is dat alle rij met in kolom A waarde "200" in kolommen achter elkaar worden geplakt in 1 rij. Vervolgens moeten de rijen met waarde "201" in kolommen achter elkaar worden geplakt. Er moet dus iets inzitten van "als/dan", denk ik.

Zie jij hier nog een oplossing voor?

 

[Roncancio]

Onderstaande code zet de waardes in de D-kolom.

Sub Samenstellen()
Dim lRij As Long
Dim lSRij As Long
Dim ikol As Integer
    lRij = 1
    While Range("A" & lRij).Value <> ""
        With Range("D1:D1000")
        Set NR = .Find(Range("A" & lRij).Value, LookIn:=xlValues, lookat:=xlPart)
            If Not NR Is Nothing Then
                ikol = Range("IV" & NR.Row).End(xlToLeft).Column + 1
                Cells(NR.Row, ikol).Value = Range("A" & lRij).Value & Space(1) & Range("B" & lRij).Value & Space(1) & Range("C" & lRij).Value
            Else
                ikol = 2
                lSRij = Range("D65536").End(xlUp).Row + 1
                Cells(lSRij, "D").Value = Range("A" & lRij).Value & Space(1) & Range("B" & lRij).Value & Space(1) & Range("C" & lRij).Value
            End If
        End With
        lRij = lRij + 1
    Wend
End Sub

Met vriendelijke groet,


Roncancio

 

[MichielM80]

Alweer een stapje dichterbij!

Nu worden alle waarden in 1 cel geplakt, maar dat zouden 3 gescheiden cellen moeten zijn:

Kolom A \ Kolom B \ Kolom C ipv Kolom A Kolom B Kolom C

En bij de herhaling moet de eerste kolom niet meer worden weergegeven:

Kolom A1 \ Kolom B1\ Kolom C1 \ Kolom B2 \ Kolom C2

Ik hoop dat dit een beetje duidelijk is en dat jij me nog verder kunt helpen!

En alvast bedankt voor de moeite.

 

[Cobbe]

Zitten we hier of zitten we daar:

http://office.webforums.nl/forum/viewtopic.php?t=35363

Cobbe

 

[Roncancio]

Ik begreep juist dat het de bedoeling was om het in 1 cel te zetten.

Sub Samenstellen()
Dim lRij As Long
Dim lSRij As Long
Dim iKol As Integer
    lRij = 1
    While Range("A" & lRij).Value <> ""
        With Range("D1:D1000")
        Set NR = .Find(Range("A" & lRij).Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not NR Is Nothing Then
                iKol = Range("IV" & NR.Row).End(xlToLeft).Column + 1
                Range("A" & lRij & ":C" & lRij).Copy Destination:=Cells(NR.Row, iKol)
            Else
                lSRij = Range("D65536").End(xlUp).Row + 1
                Range("A" & lRij & ":C" & lRij).Copy Destination:=Cells(lSRij, "D")
            End If
        End With
        lRij = lRij + 1
    Wend
End Sub

Met bovenstaande code wordt het apart geplaatst.

Met vriendelijke groet,


Roncancio

 

[Radjesh Klauke]

Is het gelukt Michiel? Dan kan je de vraag op het OfficeForum ook sluiten aub. In het vervolg niet gaan crossposten, tenzij het urgent is. Gezien de reacties op de vraag, niet erg.

 

[MichielM80]

Thx! Ik heb de macro ingevoegd en het werkt precies zoals ik bedoelde!

Er zat wat haast achter... vandaar de crosspost. Zal niet weer gebeuren

Maar superbedankt voor de snelle reacties :thumb::thumb: echt top!

Michiel