Uitdaging! gegevens uit cellen naast elkaar, onder elkaar plaatsen.

[mwelman]

Weet iemand deze macro nog te verbeteren? niet alle kolommen zijn er in opgenomen.

Hier een voor:

en een na:

Goedemiddag,

Ik heb het bestand met de macro van SNB erin aangevuld met een aantal regels waar de gegevens verdeeld over de kolommen staat.
Het werkt nog niet zo dat wanneer er geen gegevens in staan de kolommen worden overgeslagen en dat kolom N t/m V meegenomen worden.

Iemand nog ideeën?

Bekijk bijlage 235299

 

[snb]

Analyseer eerst stap voor stap wat de code doet.
Het heeft geen zin code te gebruiken die je niet begrijpt.
Een antwoord op je laatste vragen vergroot jouw kennis/inzicht niet en is natuurlijk ook weinig uitdagend.

 

[mwelman]

Bedankt voor je antwoord SNB, en ik begrijp wat je bedoelt. Echter is mijn kennis hierin dusdanig treurig dat eer ik hier iets van te leer, ik mij eerst op de basisbeginselen moet richten.
Ik heb getracht om zelf de code te wijzigen zodat deze alle benodigde kolommen pakt. Verdere info heb ik ingewonnen op en site misschien bij jou bekend?: www punt snb-vba punt e u
De code uitbreiden met: Array(1, 2, 3, 4, 5, 6, 7, 17, 18, 19), Array(1, 2, 3, 4, 5, 6, 7, 20, 21, 22)) werkt dus niet.

 

[snb]

Jullie Excel-expert zal best wel behulpzaam kunnen zijn.

 

[mwelman]

Behulpzaam is hij zeker maar helaas heeft hij geen kennis van VBA...

Jullie Excel-expert zal best wel behulpzaam kunnen zijn.

 

[VenA]

Voor 5 contactpersonen en een code die middels F8 te volgen is. Dan kan de Excel specialist ook nog wat leren:d

Het resultaat wordt op blad2 neergezet.

Sub VenA()
n = 0
ar1 = Sheets("blad1").Cells(1).CurrentRegion
ReDim ar2(UBound(ar1) * 5, 9)
    For j = 2 To UBound(ar1)
        b = False
        For jj = 8 To UBound(ar1, 2) Step 3
            If ar1(j, jj) <> "" Or ar1(j, jj + 1) <> "" Or ar1(j, jj + 2) <> "" Then
                ar2(n, 7) = ar1(j, jj)
                ar2(n, 8) = ar1(j, jj + 1)
                ar2(n, 9) = ar1(j, jj + 2)
                For jjj = 1 To 7
                    ar2(n, jjj - 1) = ar1(j, jjj)
                Next jjj
                n = n + 1
                b = True
                Else
                If Not b Then
                    For jjj = 1 To 7
                        ar2(n, jjj - 1) = ar1(j, jjj)
                    Next jjj
                    n = n + 1
                End If
                Exit For
            End If
        Next jj
    Next j
Sheets("Blad2").Cells(1).Resize(UBound(ar2), UBound(ar2, 2) + 1) = ar2
End Sub

 

[pixcel]

De expert kan zich beter in Powerquery en M verdiepen.
Vijf queries ContactpersoonX als deze:

let
    Source = Excel.CurrentWorkbook(){[Name="tblContactpersonen"]}[Content],
    #"Removed Columns" = Table.RemoveColumns(Source,{"Contactpersoon2", "Functie2", "E-mail2", "Contactpersoon3", "Functie3", "E-mail3", "Contactpersoon4", "Functie4", "E-mail4", "Contactpersoon5", "Functie5", "E-mail5"}),
    #"Renamed Columns" = Table.RenameColumns(#"Removed Columns",{{"Contactpersoon1", "Contactpersoon"}, {"Functie1", "Functie"}, {"E-mail1", "E-mail"}})
in
    #"Renamed Columns

En dan:

let
    Append = Table.Combine({Contactpersoon1,Contactpersoon2,Contactpersoon3,Contactpersoon4,Contactpersoon5}),
    #"Added Custom" = Table.AddColumn(Append, "Filter", each [Contactpersoon]<>null or [Functie]<>null or [#"E-mail"]<>null),
    #"Filtered Rows" = Table.SelectRows(#"Added Custom", each ([Filter] = true)),
    #"Removed Columns" = Table.RemoveColumns(#"Filtered Rows",{"Filter"})
in
    #"Removed Columns"

geeft het resultaat van Sheet1 (bijlage).
Het gros hiervan hoeft niet gecodeerd te worden maar komt door klikken met de muis tot stand. Excel 2010+ met de PowerQuery add in.

 

[mwelman]

Pixcel, bedankt voor de hulp. Er zijn wat zaken tussen gekomen dus ik heb nog niet kunnen testen. Powerquery staat al wel geinstalleerd nu.

 

[mwelman]

Beste Frans,

Ik ben zelf wat aan het stoeien geweest in powerquery wegens bepaalde prioriteiten.
Echter ben ik te slecht onderlegd.

Ik heb het document geopend en bij t tabje powerquery kies ik voor recent sources waar ik het huidige document kies. In de navigator kies ik blad 1 waar de data staat en kies load. Dan krijg ik al direct het bericht dat de query neer gegevens oplevert dan er op een werkblad passen. Het zijn echter maar 25 rijen en 15 kolommen dus ik ga voor doorgaan. Vervolgens krijg ik als ik je 1e code in de Advanced Editor zet het bericht no syntax errors detected. Bij doorgaan de error: Expression error: the name 'Conractpersoon1' was not recognized. Is it spelled correctly? Echter is dit wel goed. Wat kan ik hieraan doen?

Is het te veel gevraagd voor een walk through?

Groet Michiel

 

[pixcel]

PQ is geen klein dingetje, dus als je er verder mee wilt zou ik een goed boek kopen en op google/youtube zoeken.

In het bestand van #27 zit het PQ script al in. Als je PQ geinstalleerd hebt: wijzig de gegevens op Blad1, ga naar Sheet1, rechts klik in de tabel en kies Vernieuwen/Refresh. Op de PQ tab heb je dus niks meer te zoeken, tenzij de structuur van de invoertabel wijzigt.