kolom zonder lege velden

[Caran]

Ik heb in kolom A een reeks namen staan, die het resultaat zijn van TRANSPONEREN. Hier en daar staan er lege velden tussen.

Nu zou ik graag op een volgend werkblad diezelfde kolom automatisch laten verschijnen, maar dan zonder de lege velden. Hoe kan ik dat doen ?

 

[Warme bakkertje]

Sub ZonderLege()
  Dim sq() As Variant, i As Integer, c As Range
  i = -1
  For Each c In Sheets("Blad1").Columns("A").SpecialCells(xlConstants)  'alle niet-lege C-cellen in "Blad1"
    i = i + 1                                              'teller ophogen
    ReDim Preserve sq(i)                                   'uitbreiden array met behoud van gegevens
    sq(i) = c.Value                                        'nieuw element toevoegen
  Next
  Sheets("Blad2").Range("A1").Resize(UBound(sq) + 1) = WorksheetFunction.Transpose(sq)
End Sub

Pas nog wel even de juiste bladnamen aan

 

[Caran]

Dit is een macro veronderstel ik ?

Kan ik die macro automatisch laten lopen, zonder dat ik die zelf moet opstarten ?

Kan het ook door een formule in de velden in te vullen ?

Sorry voor de last ... .

 

[robdgr]

Kan het ook door een formule in de velden in te vullen ?

Dan heb je op de eerste pagina een extra kolom nodig, die je kunt verbergen.

 

[Caran]

Ik heb nog een serie kolommen waar ik hetzelfde moet doen ... . Als ik vóór elke kolom een extra kolom moet voorzien, zal ik een andere oplossing moeten zoeken. :-(

 

[robdgr]

Ik heb in kolom A een reeks namen staan, die het resultaat zijn van TRANSPONEREN. Hier en daar staan er lege velden tussen.

Als je deze informatie geeft, krijg je wat je nu hebt. Had gelijk gemeld dat het om meer kolommen gaat, dan had ik deze oplossing niet gegeven en had Rudi waarschijnlijk een andere macro gemaakt. Vermoedelijk wordt het dan toch een macro of een ingewikkelde matrixformule die op dit forum als eens eerder aan de orde is geweest

.=ALS(RIJ()-RIJ($C$10:$C$20)+1>RIJEN($C$10:$C$20)-AANTAL.LEGE.CELLEN($C$10:$C$20);"";INDIRECT(ADRES(KLEINSTE((ALS($C$10:$C$20<>"";RIJ($C$10:$C$20);RIJ()+RIJEN($C$10:$C$20)));RIJ()-RIJ($C$10:$C$20)+1);KOLOM($C$10:$C$20);4)))

Kijk maar eens in het bestand elimineren op mijn site voor de toepassing of gebruik de zoekfunctie van dit forum.
Je kunt ook kijken naar de mogelijkheden van filteren.

 

[WHER]

Nog een mogelijke aanpak met (matrix)formules.

 

[Caran]

Het lukt mij van geen kanten ... Ik heb dan ook niet veel kaas gegeten van Excel.

Ik denk dat ik best een concreet voorbeeld bijvoeg. De gegevens waarover het uiteindelijk zal gaan bevinden zich in de velden A5 tot en met IP254.

Op blad2 zou ik graag de lijst hebben zonder lege velden (per kolom).

Concreet voorbeeld in bijlage Bekijk bijlage voorbeeld.xls

 

[WHER]

Zie tabblad 2 in de bijlage. De formule is slechts voor 1 kolom ingevuld (zelf verder naar rechts slepen), anders werd het bestand te groot.

 

[Caran]

Thank you very very much WHER !!! It works !!!

 

[Caran]

Ondertussen is mijn bestand reeds 24MB en mijn laptop traag. Nu vroeg ik mij het volgende af :

De gegevens op blad (lijst!) zijn het resultaat van
=TRANSPONEREN(ALS(res!D4:IS253="";"";res!D4:IS253))

De gegevens op blad (lijst2!) zijn het resultaat van :
=ZOEKEN(HERHALING("z";10);KIEZEN({1\2};"";INDEX(lijst!A$4:A$300;KLEINSTE(ALS(lijst!A$4:A$300<>"";RIJ(lijst!A$4:A$300)-RIJ(A$4)+1;"");RIJEN($1:1)))))

Als ik de 2 formules kan combineren, dan kan ik één blad uitschakelen en vermoedelijk mijn bestand wat kleiner maken. Laptop krijgt het echt moeilijk met berekenen.

Kan dat of ben ik het een beetje te ver aan het drijven ?

 

[WHER]

Het gebruik van matrixformules over zulke grote bereiken leidt onvermijdelijk tot langere berekentijden, daar zal het samenvoegen van 2 formules weinig aan veranderen.
Eigenlijk is een macro-oplossing hier aangewezen, maar dat is niet mijn sterkste kant.
Een extra "loop" misschien in Rudi's macro uit post 2.

 

[Warme bakkertje]

Sub ZonderLege()
  Dim sq() As Variant, i As Integer, c As Range, x As Integer
  For x = 1 To Sheets("Blad1").UsedRange.Columns.Count
    i = -1
        For Each c In Sheets("Blad1").Columns(x).SpecialCells(xlConstants)
            i = i + 1                                              'teller ophogen
            ReDim Preserve sq(i)                                   'uitbreiden array met behoud van gegevens
            sq(i) = c.Value                                        'nieuw element toevoegen
        Next
    Sheets("Blad2").Cells(5, x).Resize(UBound(sq) + 1) = WorksheetFunction.Transpose(sq)
  Next
End Sub