• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

twee tabellen met overeenkomstige kolommen samenvoegen, VBA

Status
Niet open voor verdere reacties.
S

StiBe

Gebruiker
Lid geworden
23 okt 2016
Berichten
17
Beste lezer,

Ik heb twee tabellen met verschillende soorten data. De kolommen 'datum', 'user' en 'naam' komen in beide tabellen voor.
Nu wil ik beide tabellen samenvoegen tot 1 tabel, waarin samengevoegd wordt op overeenkomstige 'datum' en 'user' (zie bijgevoegd voorbeeld).

Ik heb dit geprobeerd met ADO:
Code: 
 With CreateObject("ADODB.Recordset")
    .Open "SELECT datum, shift, user, naam, SUM(nttijd), SUM(bttijd), SUM(totaal), SUM(bovenonder), SUM(incompleet), SUM(telfout), SUM(hoogte), SUM(inpakken), SUM(lo), SUM(totaalfouten) as Waarde FROM [Temp$] GROUP BY datum, user, shift, naam", "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 8.0;"""
maar omdat 'shift' niet als kolom in beide tabellen staat krijg ik deze niet samengevoegd. De waarden uit deze kolom zijn ook niet samen te voegen als 'SUM'. Andere opties geprobeerd (concatenate, text, merge) maar ik kom er niet uit.

Met stap voor stap rijen vergelijken en samenvoegen lukt het wel,
(met cell.offset en tijdelijke waarden in de lege 'shift' cellen toevoegen)
echter op deze groeiende gegevensreeks is dit een zeer trage oplossing..

wie kan mij helpen met het samenvoegen (van de kolom 'shift' waar in de ene tabel gegevens staan en de andere niet), de overige kolommen lukken me wel.
Alvast dank voor jullie inzet.

Werkbladen:
bron: de twee afzonderlijke voorbeeldtabellen (origineel bevat meerdere namen)
temp: de twee tabelklen onder elkaar, waar ik met ADO het samenvoegen op wil laten uitvoeren
Db: waar de uiteindelijke samenvoeging heen moet
Gewenst resultaat: hoe het er uiteindelijk uit komt te zien (De gemarkeerde rijen geven waarden weer welke niet in beide tabellen staan)

Bekijk bijlage samenvoegen.xlsb
 
Het kan ook zo:
De tweede tabel heb ik eerst verschoven naar kolom Q

Code: 
Sub M_snb()
   sn = Sheets("bron").Cells(1).CurrentRegion.Resize(, 14)
   sp = Sheets("bron").Cells(1, 17).CurrentRegion
   
   With CreateObject("scripting.dictionary")
        For j = 1 To UBound(sn)
           .Item(sn(j, 1) & "_" & sn(j, 3)) = Application.Index(sn, j)
        Next
        For j = 1 To UBound(sp)
          c00 = sp(j, 1) & "_" & sp(j, 2)
          If .exists(c00) Then
            st = .Item(c00)
            For jj = 4 To UBound(sp, 2)
               st(4 + jj) = sp(j, jj)
            Next
            .Item(c00) = st
          End If
        Next
        
        Sheets("bron").Cells(40, 1).Resize(.Count, 14) = Application.Index(.items, 0, 0)
   End With
End Sub
 
Out of the box:

Is het gebruiken van draaitabellen een optie? Bekijk bijlage samenvoegenGijs.xlsx
Je kunt namelijk meerdere databases in 1 draaitabel zetten door een kolom met unieke sleutels door middel van relaties te koppelen. (in voorbeeld heb ik kolom "datum" gebruikt)
 
Dank voor de snelle reacties!

Snb: Het werkt deels echter ik raak de gegevens kwijt uit de tweede tabel waarbij geen overeenkomstige datum is in de eerste tabel (zie in het bestand werkblad "bron" de gekleurde datums).

Gijsbert: Ook hierin zie ik de gegevens niet allemaal terug (zelfde als bij snb). Daarbij is het gebruik van draaitabel afhankelijk van de 'tabeldraaier'. Ik wil een statisch resultaat waar anderen middels vba knoppen eenvoudig de juiste selecties krijgen, zolas ik ze dan 'voorkauw'.

Mogelijk aanpassingen aan de code, snb? of toch middels een juiste parameter voor kolom 'shift' met ADOdb?
 
Als je de code had geanalyseerd en begrepen had je dat eenvoudig zelf kunnen doen.
Code: 
Sub M_snb()
   sn = Sheets("bron").Cells(1).CurrentRegion.Resize(, 14)
   sp = Sheets("bron").Cells(1, 17).CurrentRegion
   
   With CreateObject("scripting.dictionary")
        For j = 1 To UBound(sn)
           .Item(sn(j, 1) & "_" & sn(j, 3)) = Application.Index(sn, j)
        Next
        For j = 1 To UBound(sp)
          c00 = sp(j, 1) & "_" & sp(j, 2)
          If .exists(c00) Then
            st = .Item(c00)
            For jj = 4 To UBound(sp, 2)
               st(4 + jj) = sp(j, jj)
            Next
            .Item(c00) = st
          Else
            st = Application.Index(sn, 1)
            For jj = 1 To UBound(st)
               st(jj) = ""
               If jj = 1 Then st(jj) = sp(j, jj)
               If jj = 3 Or jj = 4 Then st(jj) = sp(j, jj - 1)
               If jj > 7 Then st(jj) = sp(j, jj - 4)
            Next
            .Item(c00) = st
          End If
        Next
        
        Sheets("bron").Cells(40, 1).Resize(.Count, 14) = Application.Index(.items, 0, 0)
   End With
End Sub
 
Beste SnB
Dank voor je oplossing, werkt voortreffelijk.
Excuses als het lijkt dat ik gemakkelijk overkom en niet zelf grasduin in de code.
Ik ben nog niet zo heel ver gevorderd met VBA dat ik alle code direct kan ontcijferen. Als code voor mij nuttig is dan ga ik me er zeker in verdiepen (zo ook de door mij gewenste ADO code, blijf zoeken naar goede handleiding hiervoor).

Groeten en nogmaals dank!
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan