Groot excelbestand met duizenden rijen vertical en hortizonaal in één kolom plaatsen

[ExcelGreenie]

hallo,

De titel zegt het al. Ik heb een groot bestand met zowel verticaal als horizontaal rijen en kolommen van honderden cellen breed en hoog. Ik zou dit willen samenvoegen naar 1 kolom. Met samenvoegen bedoel ik niet de cellen in elkaar plakken maar alle cellen/kolommen onder elkaar in 1 rij. Als dat niet in 1 keer mogelijk is omdat excel het gewoon niet aankan geen probleem, als ik maar niet 100 keer hetzelfde moet doen want dan heeft het nog weinig zin. Ik ken de functie transponeren trouwens maar daar lukt dit niet bij aangezien transponeren vooral goed lukt met 1 horizontale rij naar 1 verticale rij overzetten. Als iemand tips heeft hoor ik het graag!

Alvast bedankt.

P.S. zie screenshot.

 

[MarcelBeug]

Als je eerst een lege kolom A invoegt, dan werkt het volgende, mits de laatstgevulde cel in kolom B ook de laatste rij met data is.

Sub PlaatsDataInKolomA()
    'MarcelBeug 5 Feb 2016
    
    'Kolom A is leeg, data start in kolom B

    Dim MaxRow As Long
    Dim MaxCol As Long
    Dim i As Long
    Dim r As Long
    r = 1
    
    MaxRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    For i = 1 To MaxRow
        MaxCol = ActiveSheet.Cells(i, Columns.Count).End(xlToLeft).Column
        ActiveSheet.Cells(r, 1).Resize(MaxCol - 1, 1).Value = _
            Application.Transpose(ActiveSheet.Cells(i, 2).Resize(1, MaxCol - 1))
        r = r + MaxCol - 1
    Next i


End Sub

 

[ExcelGreenie]

Als je eerst een lege kolom A invoegt, dan werkt het volgende, mits de laatstgevulde cel in kolom B ook de laatste rij met data is.

Sub PlaatsDataInKolomA()
    'MarcelBeug 5 Feb 2016
    
    'Kolom A is leeg, data start in kolom B

    Dim MaxRow As Long
    Dim MaxCol As Long
    Dim i As Long
    Dim r As Long
    r = 1
    
    MaxRow = ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row
    For i = 1 To MaxRow
        MaxCol = ActiveSheet.Cells(i, Columns.Count).End(xlToLeft).Column
        ActiveSheet.Cells(r, 1).Resize(MaxCol - 1, 1).Value = _
            Application.Transpose(ActiveSheet.Cells(i, 2).Resize(1, MaxCol - 1))
        r = r + MaxCol - 1
    Next i


End Sub

Hallo Marcel,

Bedankt voor de snelle reactie. Waarmoet ik die code plaatsen en hoe maak ik het werkend? En excuseer maar ik begreep dit deel even niet: " mits de laatstgevulde cel in kolom B ook de laatste rij met data is. "

Voor de zekerheid zeg ik het nog even: De verticale rij is 6000 cellen lang en horizontaal loopt het tot cel YD. Ik heb de langste horizontale rij ( dus tot cel YD) getransponeerd en die is ongeveer 600 cellen lang. Als ik 6600x600 doe kom ik uit op 3.960.000. Niet alle rijen lopen tot cel YD maar er is een grote kans dat het niet in 1 Excelkolom past aangezien Excel maximaal 1.300.000 cellen lang is of heb ik het verkeerd?

Ik zal proberen smiddags te reageren. Bedankt alvast.

Jamal

 

[MarcelBeug]

Met Alt+F11 ga je naar de Visual Basic Editor
Invoegen - Module
Plak de code en voer het uit met F5

Zoals in de bijlage waaraan ik een knop heb toegevoegd om de macro te starten en ook uitgelegd heb wat ik bedoel met " mits de laatstgevulde cel in kolom B ook de laatste rij met data is. "

 

[Cobbe]

Maak 3 kolommen vrij A, B, C , D en voer de aangepaste code van Marcel uit:

Option Explicit
Sub PlaatsDataInKolomA()
    'MarcelBeug 5 Feb 2016
    
    'Kolom A is leeg, data start in kolom E

    Dim MaxRow As Long
    Dim MaxCol As Long
    Dim i As Long
    Dim r As Long, y As Long
    r = 1: y = 1
    
    MaxRow = ActiveSheet.Cells(Rows.Count, 5).End(xlUp).Row
    For i = 1 To MaxRow
        MaxCol = ActiveSheet.Cells(i, Columns.Count).End(xlToLeft).Column
        ActiveSheet.Cells(r, y).Resize(MaxCol - 1, y).Value = _
            Application.Transpose(ActiveSheet.Cells(i, 3).Resize(1, MaxCol - 1))
        r = r + MaxCol - 1: If r > 1048000 Then r = 1: y = y + 1
    Next i


End Sub

Dan wordt de data verdeeld over 4 kolommen.

 

[snb]

We gaan toch niet al die waarden apart in een werkblad schrijven ?
@Cobbe als de data in 4 kolommen terechtkomen voldoet dat toch niet aan de voorwaarde van 1 kolom ?

Wat is de lol/doel van deze excercitie ? Het bijgevoegde plaatje hielp daarbij geenszins (to put it mildly).

 

[Ginger]

Gewoon maar ff in het geheugen afhandelen en daarna pas wegschrijven lijkt mij ook beter..

Sub NaarEenKolom()

    q1 = Sheets("Sheet1").Cells(1).CurrentRegion
    ReDim q2(1 To (UBound(q1, 1) * UBound(q1, 2)), 1 To 1)
    
    For Each Inhoud In q1
        i = i + 1
        q2(i, 1) = Inhoud
    Next Inhoud
    
    With Sheets.Add(after:=ActiveSheet)
        .Cells(1).Resize(UBound(q2, 1)) = q2
    End With
    
End Sub

 

[ExcelGreenie]

Goedemiddag Marcel, Cobbe, snb en Ginger,

Ik zal even experimenteren met de suggesties en later laten weten of het is gelukt.

Bedankt tot zover alvast

 

[ExcelGreenie]

Hallo,

een beetje late reactie maar het is opgelost... Ik heb de methode van MarcelBeug gebruikt, de macro. Dat was voor mij de makkelijkste methode. Alle regels zitten nu onder elkaar in kolom A.

Iedereen bedankt!

Goed weekend.

Ciao

Jamal