tabellen combineren met query

[JEC.]

Met een omweggetje. Zo worden de formules doorgetrokken vanaf boven na uitvoeren van de macro.

Sub value()
 With ActiveSheet.ListObjects("stroom")
  .Range.AutoFilter 1, ">12-31-2019"
  Application.DisplayAlerts = False  'filterijen in een tabel verwijderen zonder melding
  .Range.Offset(1).Delete
  .Range.AutoFilter
  .ListRows.Add.Range.Resize(ActiveSheet.ListObjects("stroom_2020").ListRows.Count) = ActiveSheet.ListObjects("stroom_2020").DataBodyRange.value
 End With
Range("D2:G2").AutoFill Destination:=Range("stroom[[Totaal]:[Verbruik]]")
End Sub

 

[HSV]

Het voordeel van tabellen.

Sub value()
 With ActiveSheet.ListObjects("stroom")
  .Range.AutoFilter 1, ">12-31-2019"
  Application.DisplayAlerts = False  'filterijen in een tabel verwijderen zonder melding
  .Range.Offset(1).Delete
  .Range.AutoFilter
  .ListRows.Add.Range.Resize(ActiveSheet.ListObjects("stroom_2020").ListRows.Count, [COLOR=#ff0000]3[/COLOR]) = ActiveSheet.ListObjects("stroom_2020").DataBodyRange.value
 End With
End Sub

 

[VenA]

Waarom wil je de historische data verwijderen? Kan je wat leuke analyses maken maar dan gooi je de data weg

Sub VenA()
  With Sheets("StroomTotaal")
    ar = .ListObjects(2).DataBodyRange
    .ListObjects(1).ListRows.Add.Range.Resize(UBound(ar), 3) = ar
    .ListObjects(1).Range.RemoveDuplicates Array(1, 2, 3, 4, 5, 6, 7), xlYes
  End With
End Sub

 

[HSV]

Hij overschrijft gewoon de historische data.

De removeduplicates had ik ook op de in eerste instantie 2 kolommen, maar in het geval er dubbele data in staat gaat deze verloren.

 

[Dick34]

Ik weet niet welke code het meest sophisticated is. Wel zie ik dat de code van JV het gewenste resultaat geeft, de andere 2 macro's geven een fout in de kolom "verbruik" per 31-12-2019 (de laatste rij van de de tabel "stroom" voor de toevoeging.

Allen zeer bedank!!

Met vriendelijke groet,
Dick

 

[HSV]

Er zit een verwijzing in de formule naar een rij er eronder.

Binnen de tabel:
Dan maakt het niet uit waar de tabel zich bevindt (qua snelheid zal het niet veel schelen).

Sub value()
 With ActiveSheet.ListObjects("stroom")
  .Range.AutoFilter 1, ">12-31-2019"
  Application.DisplayAlerts = False  'filterijen in een tabel verwijderen zonder melding
  .DataBodyRange.Offset(1).Delete
  .Range.AutoFilter
  .ListRows.Add.Range.Resize(ActiveSheet.ListObjects("stroom_2020").ListRows.Count, 3) = ActiveSheet.ListObjects("stroom_2020").DataBodyRange.value
  .DataBodyRange.Columns(7) = .DataBodyRange(1, 7).Formula
 End With
End Sub

 

[Dick34]

@Harry,

Deze werkt, mits er in tabel "stroom" minstens één rij uit 2020 staat. Als deze tabel loopt t/m 31-12-2019 (of eerder) gaat het fout, want hij vindt geen rijen om te deleten. Ik dacht dat de foutmelding was afgevangen, maar toch niet.

Met vriendelijke groet,
Dick

 

[HSV]

Aangepast in vorig schrijven.

 

[Dick34]

Beste mensen,

Het gaat toch niet zo soepel als ik had gehoopt. Bij het implementeren van de macro's in het operationele bestand werken de macro's niet (foutmeldingen). Ook is het lastig om de macro's te laten werken op andere tabellen-combinaties, o.a. moeten de kolomnummers worden aangepast. Maar het grootste probleem is - en dat heb ik over het hoofd gezien bij het testen van de macro's in het voorbeeldbestand - dat het deleten van de rijen in de hoofdtabel gevolgen heeft voor de draaitabellen en andere overzichten die verwijzingen bevatten naar deze hoofdtabel. Ik zal deze verwijzingen opnieuw moeten instellen, want ze zijn verdwenen.
De oplossing moet dus gezocht worden in het toevoegen van de nieuwe records uit de subtabel. Ik ben hier bij de copy/paste methode nooit tegen aangelopen, omdat ik altijd alleen de nieuwe rijen heb toegevoegd.
De macro moet dus kijken in de hoofdtabel naar de datum in kolom 1 van de laatste rij en uit de subtabel alleen die rijen ophalen met in kolom 1 een datum die later ligt dan de eerstbedoelde datum. Zoiets.
Mochten jullie nog zin hebben op jullie kennis en kunde op dit probleem te beproeven, dan verneem ik dat graag. Zo niet, dan even goede vrienden.

Met vriendelijke groet,
Dick

 

[JEC.]

Hi Dick,

Probeer deze eens. Duurt wel wat langer maar werkt bij mij wel

Sub j()
Dim R As Range
Set Table = ActiveSheet.ListObjects("stroom_2020")
Set Table2 = ActiveSheet.ListObjects("stroom")
Set tableData = Table.ListColumns(1).DataBodyRange
Set laatste = ActiveSheet.ListObjects("stroom").ListColumns(1).DataBodyRange.Cells.Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
    
    For Each R In tableData.Rows
        If R > laatste Then
            Table2.ListRows.Add.Range.Resize(, 3) = R.Resize(, 3).value
        End If
    Next
End Sub

 

[HSV]

Sub hsv()
Dim Lo As Object
Set Lo = ActiveSheet.ListObjects("stroom_2020")
 With ActiveSheet.ListObjects("stroom")
  Application.DisplayAlerts = False
  Lo.Range.AutoFilter 1, ">" & CLng(.DataBodyRange(.ListRows.Count, 1).value)
  Lo.Range.Offset(1).Copy .DataBodyRange(.ListRows.Count + 1, 1)
  Lo.Range.AutoFilter
    If .DataBodyRange(.ListRows.Count, 1) = "" Then .DataBodyRange(.ListRows.Count, 1).Resize(, 7).Delete
  .DataBodyRange.Columns(7) = .DataBodyRange(1, 7).Formula
 End With
End Sub

 

[Dick34]

Ik heb de codes getest in een kopie van mijn bestand.

@jv: ik krijg in jouw code niet berekende waarden in de kolom "verbruik". De formule verwijst naar een veld in een rij die buiten de tabel valt.

@harry: jouw code werkt zonder fouten op mijn werktabellen "stroom"en "stroom_2020". Ik heb deze code ook toegepast op een andere combinatie van 2 tabellen (meterstanden van het gasverbruik). Ik heb in de code de namen van de tabellen aangepast (in "gas" en "gas_2020"), ik heb het cijfer 7 veranderd in 5 (want de hoofdtabel "gas" heeft 5 kolommen (opnamedatum, gas, jaar, maand, verbruik). Dit bleek echter niet geheel te werken, want in de tabel "gas_2020" (2 kolommen: opnamedatum en gas) kwamen er een groot aantal rijen te voorschijn, waarbij in de kolom "opnamedatum" vreemde datums stonden en de kolom "gas" leeg bleef. Ik heb toen in de code bij listrows.count het cijfer 1 veranderd in 2. Daarna werkte de code.
Ik moet zeggen dat ik deze laatste wijziging enigszins op goed geluk heb gedaan. Enige uitleg bij de code zou welkom zijn. Ik begrijp met name niet waarom er eerst rijen worden toegevoegd aan de sub-tabel ("stroom_2020" resp. "gas_2020", die vervolgens weer worden deleted.

Alle dank en waardering voor de tijd en moeite die jullie hebben genomen om mij te helpen! Mijn kennis van VBA is bovendien niet meer nihil.

Met vriendelijke groet,
Dick