Excelsheets dynamisch combineren

[GBO]

Ik zoek een VB-code waarmee ik een excelsheet up-to-date kan houden.

In een map staan een aantal excelbestanden waarvan de naam begint met POS en één excelbestand met de naam overzicht.xlsm. In dat laatste bestand wil ik een knop (VB) die automatisch en dynamisch uit alle andere excelsheets de gegevens uit het eerste tabblad, kolom A t/m D importeert in en tabblad samenvatting. De kolommen in de excelsheets bestaan uit:

kolom A: aantal
Kolom B: naam
Kolom C: omschrijving
Kolom C: kleur

Als de waardes in kolom B, C en D gelijk zijn mogen deze in het tabblad samenvatting gecombineerd worden, waarbij de aantallen natuurlijk cumulatief zijn. Ik heb een voorbeeld van een excel-bestand bijgevoegd. Het aantal excelbestanden kan oplopen tot 50.

Het excelbestand overzicht.xlsm heeft meerdere tabbladen, waarvan het eerste tabblad samenvatting heet. op dit tabblad bevindt zich ook de knop voor het importeren van gegevens. Als er een bestand met de naam POS* wordt toegevoegd in de map en/of de knop opnieuw wordt ingedrukt, moet het overzicht op het eerste tabblad samenvatting geactualiseerd worden.

Is dit mogelijk?

 

[JEC.]

Kijk eens naar power query ipv vba

 

[jverkerk]

Wil eerst wel eens weten welke Excel versie ivm .xls

 

[emields]

Ik denk dat je het verkeerde voorbeeldje geplaatst hebt.

 

[AHulpje]

Wat meer POS*.xlsx voorbeeldbestanden zou handig zijn, en ik neem aan dat in kolom D de kleur staat.
Mogen de POS* bestanden na verwerking verwijderd worden of moet er een administratie worden bijgehouden welke bestanden reeds verwerkt zijn?
Kan het voorkomen dat een POS* bestand overschreven wordt door een nieuwe versie?

 

[GBO]

Ik werk met 365 voor bedrijven, versie 2410.
De POS-bestanden moeten wel blijven staan, als het goed is worden die niet overschreven. Administratie hoeft niet, het is de bedoeling dat uitsluitend definitieve bestanden worden overgezet naar deze map. En inderdaad een typefoutje, kleur staat in kolom D

 

[AHulpje]

Om te voorkomen dat bestanden twee keer worden verwerkt zal er toch enigerlei vorm van administratie moeten worden bijgehouden, misschien is het alleen voldoende om de meest recente importdatum/tijd bij te houden en alleen nieuwere bestanden te importeren? Dan moet je er wel van kunnen uitgaan dat nieuwe bestanden direct na aanmaken in de importmap worden geplaatst.
En is het werkelijk nodig om de POS bestanden "dynamisch" te verwerken? Is eenmaal aan het einde van de werkdag niet voldoende of wordt er tussentijds steeds in het overzichtbestand gekeken?
Met welke frequentie dienen de POS bestanden verwerkt te worden?
En zonder een aantal POS bestandjes is het natuurlijk erg lastig testen.

 

[GBO]

Ik wil eigenlijk naar de situatie dat alleen definitieve bestanden worden geplaatst in de map.
Met dynamisch bedoel ik eigenlijk dat het bestand moet updaten op het moment dat de knop hiervoor op het verzamelblad wordt ingedrukt. Eigenlijk moet dan de bestaande lijst leeggemaakt en opnieuw gevuld worden. Een overzicht van welke bestanden zijn meegenomen (bijvoorbeeld op het tweede tabblad) is nooit verkeerd, maar als bij het indrukken van de knop de lijst eerst leeggemaakt wordt is dat mijns inziens overbodig.
Ik heb nog drie excelbestanden toegevoegd om te kunnen testen

 

[AHulpje]

Probeer het hier eens mee, plaats dit bestand in de map waarin de POS bestanden geplaatst worden.
N.B. Identieke onderdelen worden nog niet gesommeerd, eerst maar eens kijken hoe dit bevalt.

 

[Warme bakkertje]

Nog eentje.

Sub RunQueryAll()
    Dim folderpath As String, filename As String, sn As Variant
    Dim sq As Variant, j As Long, jj As Long
    Dim cn As Object, rs As Object
    
    Cells.Delete Shift:=xlUp
    folderpath = "D:\My Storage\"
    filename = Dir(folderpath & "*.xls")
    Range("A1").Resize(, 4) = [{"Aantal", "Naam", "Omschrijving", "Kleur"}]
    
    Do While filename <> ""
        If Left(filename, 3) = "POS" Then
            flname = folderpath & filename
            Set cn = CreateObject("ADODB.Connection"): Set rs = CreateObject("ADODB.Recordset")
                cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=" & flname & ";" & _
                "Extended Properties='Excel 12.0 Xml; HDR=NO';"
            cn.Open
            With rs
                .ActiveConnection = cn
                .CursorType = 3
                .Source = "SELECT * FROM [Xdwgpos$]"
                .Open
                sn = .GetRows: .MoveFirst
            End With
            rs.Close: Set rs = Nothing

            ReDim sq(1 To UBound(sn, 2) + 1, 1 To UBound(sn, 1) + 1)
            For j = 0 To UBound(sn)
                For jj = 0 To UBound(sn, 2)
                    sq(jj + 1, j + 1) = sn(j, jj)
                Next
            Next
            Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sq), UBound(sq, 2)) = sq
            Erase sq
       End If
       filename = Dir
    Loop
    cn.Close: Set cn = Nothing
    Cells.EntireColumn.AutoFit
End Sub

 

[jverkerk]

Ik heb een poging gewaagd met power query.
Zet de bestanden die beginnen met POS in een map.
Wijzig in het bestand Overzicht de bron in de power query Editor.
De handigste PQ specialisten kunnen het zo maken dat alle bestanden die beginnen met POS automatisch toegevoegd worden als je ze in dezelfde map plaatst.
Mijn kennis van PQ reikt niet verder.

 

[AHulpje]

En deze versie sommeert de aantallen identieke onderdelen.

 

[Warme bakkertje]

@AHulpje
Ik weet dat het voor jou een gevoelig item is maar omdat TS erover spreekt dat het aantal bestanden kan oplopen tot 50 heb ik aanpassingen aangebracht aan jouw code die voor mij persoonlijk beter aanvoelen.
Draai ze beiden maar eens na elkaar en laat maar iets weten.

 

[GBO]

Dit is fantastisch! Precies wat ik zoek. Ik kan niet overzien wat het verschil is tussen de versies van @AHulpje en @Warme bakkertje (zal met de code te maken hebben, vermoed ik), want de uitkomsten zijn hetzelfde. Beide doen exact wat ik nodig heb.
@jverkerk : ik ga zeker nog kijken naar power query. Maar omdat we voor deze excelsheet meerdere gebruikers gaan hebben, die niet allemaal de kennis hebben van Excel, laat ik het voor nu even voor wat het is.
Allemaal super bedankt voor de hulp!

 

[AHulpje]

@Warme bakkertje
Zoals je ziet heb ik ook gebruik gemaakt van een array, dus zo gevoelig ligt het niet hoor.
Ik denk dat mijn code voor de beginnende VBA-er iets makkelijker te begrijpen is, maar die van jou is ruim vijf keer zo snel. Met 52 POS bestanden (kopietjes van elkaar) draait mijn oplossing in 17,5 seconden en die van jou in 3,3, een heel mooi resultaat. Het gebruik van jouw sorteer- en sommeerfunctie maakt mijn oplossing slechts een halve seconde sneller, 17 sec, dus daar zit het verschil niet in. Het grote verschil zit hem denk ik in het gebruik van recordsets waardoor het POS bestand niet in zijn geheel hoeft te worden ingelezen. Is mijn aanname juist?
Heeft de .MoveFirst nog enig nut?
Overigens voelt het gebruik van meerdere statements op een regel voor mij persoonlijk niet prettig aan.

 

[Warme bakkertje]

Die MoveFirst mag idd weg (restant van andere code). Net zoals die Erase sq aangezien je met het gebruik van Redim de array ook helemaal wist. (deed dit meer als extra zekerheid).
Zoals je inderdaad al aanhaalt zal het sorteren en samenvatten niet het grote verschil maken.(het zit maar in het koppeke)
Mijn inziens zit het grote verschil erin dat met jouw code elk bestand fysiek geopend moet worden, de in houd gekopieerd en geplakt wordt en het bestand terug gesloten wordt en dit dan x het aantal bestanden.
Met mijn code wordt de inhoud gelezen vanuit een 'gesloten' bestand en dan geplakt.

 

[JEC.]

Zou zeker voor Power Query gaan. Dit is alles wat je nodig hebt. Open een "blank query" en plak dit in de advanced editor. Wel even je folder pad aanpassen

let
    Source = Folder.Files("C:\Users\xxx\Downloads"),
    fx = (x)=> Table.SelectRows( Excel.Workbook(x),each [Name] = "Xdwgpos")[Data],
    filter = List.Transform(Table.SelectRows(Source, each Text.StartsWith([Name], "POS"))[Content], fx),
    toTable = Table.Combine(List.Combine(filter)),
    result = Table.RenameColumns(toTable,{{"Column1", "Aantal"}, {"Column2", "Naam"}, {"Column3", "Omschrijvng"}, {"Column4", "Kleur"}})
in
    result

 

[AHulpje]

@JEC.
Heb een nieuwe query geopend, je query er in geplakt, pad aangepast, uitgevoerd, maar geeft als resultaat alleen de tekst van de query op rij 2. Ik doe dus iets helemaal fout. Wat?
Kun jij je document met query hier plaatsen, ik wil dit ook kunnen!
Zo aan de query te zien worden de aantallen identieke onderdelen nog niet gesommeerd, maar dat is vast toe te voegen met een extra query?

 

[jverkerk]

@JEC.
Bij mij werkt de query prima, alleen als er meerdere van dezelfde voor komen zouden deze bij elkaar opgeteld moeten worden "Aantal", zou dat nog lukken?
Zelfde wat @AHulpje bedoeld denk ik.
Ik heb het denk ik zelf al gevonden door te groeperen en de som van aantal, misschien kan het nog beter hoor.
Werkt bij allebei. Had er nog een bestandje bij gemaakt.

 

[snb]

@WB

Of ??

Sub M_snb()
    Application.ScreenUpdating = False
    Cells(1).CurrentRegion.ClearContents
    Sheets("Totaal").Cells(1).CurrentRegion.ClearContents
    Cells(1).Resize(, 4) = Split("Aantal Naam Omschrijving Kleur")
    Sheets("Totaal").Range("A1").Resize(, 4) = Range("A1:D1")
  
    c00 = Dir(ThisWorkbook.Path & "\POS*.xls")
    Do While c00 <> ""
        sn = GetObject(ThisWorkbook.Path & "\" & c00).Sheets(1).UsedRange
        Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sn), UBound(sn, 2)) = sn
        c00 = Dir
    Loop
    Columns.AutoFit

    Sheets("Totaal").UsedRange.Sort Cells(1, 2), , Cells(1, 3), , , Cells(1, 4), , 1
    Sheets("Totaal").Columns.AutoFit

    With ThisWorkbook.PivotCaches.Create(1, Blad2.Cells(1).CurrentRegion, 4).CreatePivotTable(Cells(10, 6), "snb", , 4)
       For j = 2 To 4
         .PivotFields(j).Orientation = 1
       Next
      
       .AddDataField .PivotFields(1), "Aantallen", -4157
       .RowAxisLayout 1
       For Each it In .PivotFields
         it.Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
       Next
    End With
    
    ActiveWorkbook.ShowPivotTableFieldList = False
End Sub