Samenvatting maken uit meerdere tabellen VBA

Status
Niet open voor verdere reacties.
Dank je Harry. Werkt goed.

Mocht je een oplossing hebben van mijn andere vraag ("Hoe gaat de code om indien er bijvoorbeeld 4 sectoren zijn? Moet hiervoor cases aangemaakt worden?"), dan hoor ik het graag.

Met vriendelijke groet,

Roy.
 
Bezint eer ge begint.
Daarna 5 of 6?

Dan had ik de code wel heel anders geschreven denk ik.
1 Listobject, geen lege kolommen, etc., etc.
 
Ik begreep van de inspecteur dat het per gebouw kan verschillen.
De meeste hebben max 3 energiesectoren dan kom ik met de huidige code wel mee weg, maar er komt ook (wel eens) voor dat er 4 of 5 sectoren zijn.
 
Wil je een nieuw bestand maken?
 
Hoi Harry.

Ik heb de template zo goed als klaar. Ook de Userform (andere post) is ook al klaar.

Alleen zit ik met de sectoren die meer dan 3 kan zijn. Had dit helaas niet eerder vernomen van de inspecteurs. Ik zou eventueel ook elke keer een object kunnen toevoegen, maar weet niet of dit steeds handig is.
Weet niet of het veel werk is om de code aan te passen.

Groeten,

Roy
 
Roy,

Dan komen er natuurlijk kolommen bij met 'verlichting 4' etc. of niet?
Ik verneem het wel.
 
Nee er komt geen set (object) verlichting bij. De sector (1, 2, 3, 4 etc) wordt alleen met een getal weergegeven in kolom L die geassocieerd is met een kamer- of ruimtenummer (per rij in de tabel).

De code wat je nu hebt gemaakt, zoekt in kolom L naar de sectoren 1, 2 of 3. Hier zou dan een 4e of 5e sector etc opgegeven kunnen worden. Vervolgens maakt hij een samenvatting van deze sectoren (dus 1, 2, 3 etc) waarbij dan de soort, type en aantal verlichting per sector wordt samengevat (zoals je nu al hebt gemaakt).

Per set (obj1, obj2 en obj3) bevat dus een soort-, type- en aantal verlichting Een 4e set (obj4) is dan ook niet nodig aangezien de sectoren in kolom L wordt weergegeven die dan samengevat dient te worden.

Hoop dat het een beetje duidelijk is.

Groeten,
Roy
 
En onder welk obj nummer zou je de 4 en 5 willen zien?
 
Als ik het goed heb, dan wordt eerst de energiesector (1,2 of 3) in kolom L gescand en vervolgens de bijbehorende set verlichting (obj1,2 en dan 3) . Dit doet de code tot rij 397 uit mijn hoofd waarbij de lege rijen worden genegeerd.

Is het niet zo, indien ik de energiesector in kolom L in rij 200 (als voorbeeld) aanpas naar 4 of 5, dat de code dit als een aparte sector ziet en deze dan moet apart in de samenvatting weergeeft met bij behorende verlichting?

Per rij/regel/ruimtenummer kan je maar 1 sector hebben met 3 verschillende verlichting (soort, type en aantal).

Kan de code niet zodanig aangepast worden dat per regel (incl. Obj1, obj2 en obj3) wordt gescand en op het eind de samenvatting weergeeft met aantal sectoren en bijbehorende verlichting?

Anders moet ik maandag even een voorbeeld sturen van hoe het eruit moet zien.

Mvg
 
Zo bedoel je Roy?

Code: 
Sub Samenvatting_Verlichting()
Dim sv, a, b(4), i As Long, obj1 As Object, obj2 As Object, obj3 As Object
Set obj1 = CreateObject("scripting.dictionary")
Set obj2 = CreateObject("scripting.dictionary")
Set obj3 = CreateObject("scripting.dictionary")
Set obj4 = CreateObject("scripting.dictionary")
Set obj5 = CreateObject("scripting.dictionary")


Application.EnableEvents = False


With Blad2
 sv = .Range("L2:AK393")
     For i = 1 To UBound(sv)
      With Choose(sv(i, 1), obj1, obj2, obj3, obj4, obj5)
      
        If sv(i, 4) <> "" Then
          a = .Item(sv(i, 1) & sv(i, 4) & sv(i, 5))
               If IsEmpty(a) Then a = b
                 a(0) = sv(i, 1)
                 a(1) = sv(i, 4)
                 a(2) = sv(i, 5)
                 a(3) = a(3) + IIf(sv(i, 6) = "", 0, sv(i, 6))
                 a(4) = a(4) + IIf(sv(i, 8) = "", 0, sv(i, 8))
                 .Item(sv(i, 1) & sv(i, 4) & sv(i, 5)) = a
          End If
        
        If sv(i, 13) <> "" Then
             a = .Item(sv(i, 1) & sv(i, 13) & sv(i, 14))
               If IsEmpty(a) Then a = b
                 a(0) = sv(i, 1)
                 a(1) = sv(i, 13)
                 a(2) = sv(i, 14)
                 a(3) = a(3) + IIf(sv(i, 15) = "", 0, sv(i, 15))
                 a(4) = a(4) + IIf(sv(i, 17) = "", 0, sv(i, 17))
                .Item(sv(i, 1) & sv(i, 13) & sv(i, 14)) = a
            End If
        
        If sv(i, 22) <> "" Then
             a = .Item(sv(i, 1) & sv(i, 22) & sv(i, 23))
               If IsEmpty(a) Then a = b
                 a(0) = sv(i, 1)
                 a(1) = sv(i, 22)
                 a(2) = sv(i, 23)
                 a(3) = a(3) + IIf(sv(i, 24) = "", 0, sv(i, 24))
                 a(4) = a(4) + IIf(sv(i, 26) = "", 0, sv(i, 26))
                .Item(sv(i, 1) & sv(i, 22) & sv(i, 23)) = a
             End If
        End With
      Next i
      
aantal = Application.Max(obj1.Count, obj2.Count, obj3.Count)
 If aantal > 0 Then
    .Cells(396, 26).Resize(393, 29).ClearContents
    If obj1.Count > 0 Then
      .Cells(396, 26).Resize(obj1.Count, 5) = Application.index(obj1.items, 0, 0)
      .Cells(396, 26).Resize(obj1.Count, 5).Sort .Cells(396, 27), , .Cells(397, 28), , , , , 2
      .Cells(396, 26).Offset(aantal + 1, 4) = Evaluate("sum(" & .Cells(396, 30).Address & ":" & .Cells(396 + obj1.Count, 30).Address & ")")
    End If
    
    If obj2.Count > 0 Then
      .Cells(396, 32).Resize(obj2.Count, 5) = Application.index(obj2.items, 0, 0)
      .Cells(396, 32).Resize(obj2.Count, 5).Sort .Cells(396, 33), , .Cells(397, 34), , , , , 2
      .Cells(396, 32).Offset(aantal + 1, 4) = Evaluate("sum(" & .Cells(396, 36).Address & ":" & .Cells(396 + obj2.Count, 36).Address & ")")
    End If
    
    If obj3.Count > 0 Then
      .Cells(396, 38).Resize(obj3.Count, 5) = Application.index(obj3.items, 0, 0)
      .Cells(396, 38).Resize(obj3.Count, 5).Sort .Cells(396, 39), , .Cells(397, 40), , , , , 2
      .Cells(396, 38).Offset(aantal + 1, 4) = Evaluate("sum(" & .Cells(396, 42).Address & ":" & .Cells(396 + obj3.Count, 42).Address & ")")
    End If
    
    If obj4.Count > 0 Then
      .Cells(396, 44).Resize(obj4.Count, 5) = Application.index(obj4.items, 0, 0)
      .Cells(396, 44).Resize(obj4.Count, 5).Sort .Cells(396, 45), , .Cells(397, 46), , , , , 2
      .Cells(396, 44).Offset(aantal + 1, 4) = Evaluate("sum(" & .Cells(396, 48).Address & ":" & .Cells(396 + obj4.Count, 48).Address & ")")
    End If
    
    If obj5.Count > 0 Then
      .Cells(396, 50).Resize(obj5.Count, 5) = Application.index(obj5.items, 0, 0)
      .Cells(396, 50).Resize(obj5.Count, 5).Sort .Cells(396, 51), , .Cells(397, 52), , , , , 2
      .Cells(396, 50).Offset(aantal + 1, 4) = Evaluate("sum(" & .Cells(396, 54).Address & ":" & .Cells(396 + obj5.Count, 54).Address & ")")
    End If
    
  End If
 End With
 Application.EnableEvents = True
 End Sub
 

Bijlagen

  • Test_samenvatting3.xlsb
    206 KB · Weergaven: 28
Goedemorgen Harry,

Dit is inderdaad wat ik bedoel. Dank hiervoor.

Ik neem aan dat ik de objecten ook moet toevoegen bij Dim evenals bij Aantal =......?

Kan ik dit in de template uitbreiden tot standaard 10 sectoren zodat ik gedekt ben bij de meest ingewikkelde gebouwen?

Ik ontdekte ook een ander punt.
De rijen in tabel2 bevat x aantal rijen. Toevallig kwam ik gisteren een gebouw tegen die 550 rijen nodig had.
Dit betekende dat ik de regels bij Cells(396,x) en Cells(397,x) moest aanpassen.

Ik wil een referentie cel (defined name) in Excel aanmaken met de naam "samenvatting" zodat de samenvatting vanaf dit punt wordt weergegeven.
Hiermee tackle ik het probleem dat ik steeds de regelnummers in de code moet gaan aanpassen.

Sommige gebouwen hebben misschien 200 rijen nodig en andere misschien wel meer dan 500.
Hoe wordt dit in de code aangepast zodat de samenvatting vanaf dit referentie celnaam wordt weergegeven?

Mvg
Roy
 
Wegschrijven naar een ander blad is de beste optie.
 
Ja dat zei ik ook al tegen die inspecteurs. Die willen alles op 1 blad zien.

Ik ga een sheet Samenvatting aanmaken.
Hoe wordt dit in de code aangegeven?
Sheet Samenvatting en starten vanaf cel A2.
 
Het laatste stuk.
Code: 
aantal = Application.Max(obj1.Count, obj2.Count, obj3.Count)
 If aantal > 0 Then
  With Sheets("samenvatting")
    .UsedRange.ClearContents
    If obj1.Count > 0 Then
      .Cells(2, 1).Resize(obj1.Count, 5) = Application.Index(obj1.items, 0, 0)
      .Cells(2, 1).Resize(obj1.Count, 5).Sort .Cells(2, 2), , .Cells(2, 3), , , , , 2
      .Cells(2, 1).Offset(aantal + 1, 4) = Evaluate("sum(" & .Cells(2, 5).Address & ":" & .Cells(2 + obj1.Count, 5).Address & ")")
    End If
    
    If obj2.Count > 0 Then
      .Cells(2, 7).Resize(obj2.Count, 5) = Application.Index(obj2.items, 0, 0)
      .Cells(2, 7).Resize(obj2.Count, 5).Sort .Cells(2, 8), , .Cells(2, 9), , , , , 2
      .Cells(2, 7).Offset(aantal + 1, 4) = Evaluate("sum(" & .Cells(2, 11).Address & ":" & .Cells(2 + obj2.Count, 11).Address & ")")
    End If
    
    If obj3.Count > 0 Then
      .Cells(2, 13).Resize(obj3.Count, 5) = Application.Index(obj3.items, 0, 0)
      .Cells(2, 13).Resize(obj3.Count, 5).Sort .Cells(2, 14), , .Cells(2, 15), , , , , 2
      .Cells(2, 13).Offset(aantal + 1, 4) = Evaluate("sum(" & .Cells(2, 17).Address & ":" & .Cells(2 + obj3.Count, 17).Address & ")")
    End If
    
    If obj4.Count > 0 Then
      .Cells(2, 19).Resize(obj4.Count, 5) = Application.Index(obj4.items, 0, 0)
      .Cells(2, 19).Resize(obj4.Count, 5).Sort .Cells(2, 20), , .Cells(2, 21), , , , , 2
      .Cells(2, 19).Offset(aantal + 1, 4) = Evaluate("sum(" & .Cells(2, 23).Address & ":" & .Cells(2 + obj4.Count, 23).Address & ")")
    End If
    
    If obj5.Count > 0 Then
      .Cells(2, 25).Resize(obj5.Count, 5) = Application.Index(obj5.items, 0, 0)
      .Cells(2, 25).Resize(obj5.Count, 5).Sort .Cells(2, 26), , .Cells(2, 27), , , , , 2
      .Cells(2, 25).Offset(aantal + 1, 4) = Evaluate("sum(" & .Cells(2, 29).Address & ":" & .Cells(2 + obj5.Count, 29).Address & ")")
    End If
   End With
  End If
 End With
 Application.EnableEvents = True
 End Sub
 
Oké ik zal dit testen als ik achter de computer zit.

Kan ik in de template uitbreiden tot standaard 10 sectoren zodat ik gedekt ben bij de meest ingewikkelde gebouwen?
 
Dacht ik het niet in een van mijn eerder schrijven?

Dat kan, maar dan zou ik overschakelen naar de tweede code in mijn eerste bijdrage.
 
Ik dacht meer aan het gebruik van draaitabellen in rij 400:

NB. De formule in kolom S (en overeenkomstige) is onnodig gecompliceerd:
PHP: 
=Q2*R2
is voldoende
De validatieregel van kolom P (en overeenkomstige) kan beperkt blijven tot
PHP: 
=indirect(O2)
 

Bijlagen

  • __draaitabel_snb.xlsb
    210,1 KB · Weergaven: 22
Laatst bewerkt:
Beste SNB,

Is de draaitabel op basis van Energiesector aangemaakt (kolom L)?

Ik had in het verleden een code gevonden, maar weet niet of dit echt bruikbaar is:

Code: 
Sub SnelstartNaarDraaitabel()
    'Declareer eerst de variabelen
    'We gaan een draaitabel maken en plaatsen op het werkblad [Draaitabel_Omzet]
    'Hiervoor moeten we in VBA eerst de draaitabel declareren
    Dim Draaitabel As PivotTable
    'De variabele [Werkblad_Brondata] stelt VBA in staat het juiste werkblad met onze bron gegevens te vinden en er te lezen en te schrijven
    Dim Werkblad_Brondata As Worksheet
    'De variabele [RangeBereik] stelt VBA in staat een range te selecteren op een werkblad
    Dim RangeBereik As Range
    'In de variabele [Draaitabel_Cache] slaan we tijdelijk gegevens op die we laten nodig hebben in de draaitabel
    Dim Draaitabel_Cache As PivotCache
    'Met deze variabele geven we aan waar de draaitabel moet worden geplaatst
    Dim Werkblad_Draaitabel As Worksheet
    'Tot slot declareren we een variabele die de waarde van een draaitabel veld kan bevatten
    Dim Draaitabel_veld As PivotField
    
    'Nu gaan de we de variabelen gebruiken door ze toe te wijzen
    
    'De brondata uit Snelstart vindt je op het tabblad [Snelstart] uiteraard heb ik deze data hier neergezet en de naam van het tabblad aangepast.
    Set Werkblad_Brondata = Worksheets("Snelstart")
    'Nu vertellen we de variabele [Werkblad_Draaitabel] waar we de draaitabel willen plaatsen
    Set Werkblad_Draaitabel = Worksheets("Draaitabel_Snelstart")
    
    'Om deze functie telkens opnieuw te kunnen aanroepen moeten we de eventueel aanwezige draaitabel op het tabblad [Werkblad_Draaitabel] verwijderen
    For Each Draaitabel In Werkblad_Draaitabel.PivotTables
        Draaitabel.TableRange2.Clear
    Next Draaitabel

    'Nu vertellen we de functie dat de data op ons werkblad [Snelstart] een bereik heeft van veld A1 tot en metG32
    Set RangeBereik = Werkblad_Brondata.Range("A1:G32")
    
    'Nu wordt het even spannend want er zitten versie verschillen in de aanroep van de functie die de draaitabel prepareert in het geheugen
    'Afhankelijk van de versie die je gebruikt aan of uitzetten
    Select Case Application.Version
        Case "11.0" 'Excel 2003
            ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=RangeBereik, Version:=xlPivotTableVersion11).CreatePivotTable TableDestination:=Werkblad_Draaitabel.Range("A1"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion11
        Case "12.0" 'Excel 2007
            ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=RangeBereik, Version:=xlPivotTableVersion12).CreatePivotTable TableDestination:=Werkblad_Draaitabel.Range("A1"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion12
        Case "14.0" 'Excel 2010
            ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=RangeBereik, Version:=xlPivotTableVersion14).CreatePivotTable TableDestination:=Werkblad_Draaitabel.Range("A1"), TableName:="PivotTable1", DefaultVersion:=xlPivotTableVersion14
    End Select
    
    'Nu maken we een nieuwe draaitabel
    Set Draaitabel = Werkblad_Draaitabel.PivotTables("PivotTable1")

    'Standaard is de handmatige update property uitgezet. Aangezien we graag de data eerst moeten verwerken zet ik deze actie op waar
    Draaitabel.ManualUpdate = True

    'Voeg een rij, kollom en filter toe aan de draaitabel
    
    'We willen een filter plaatsen op het veld jaar zodat we per jaar de gegevens kunnen bekijken
    Set Draaitabel_veld = Draaitabel.PivotFields("Jaar")
    Draaitabel_veld.Orientation = xlPageField

    'Nu voegen we 2 velden toe waarop we de data willen groeperen. In het voorbeeld heb ik gekozen voor de plaats en vervolgens de klanten per plaats
    Set Draaitabel_veld = Draaitabel.PivotFields("Plaats")
    Draaitabel_veld.Orientation = xlRowField
    Draaitabel_veld.Position = 1

    Set Draaitabel_veld = Draaitabel.PivotFields("Naam")
    Draaitabel_veld.Orientation = xlRowField

    'De omzet wil ik per maand analyseren en de maand moet dus horizontaal de omzet tonen
    Set Draaitabel_veld = Draaitabel.PivotFields("Maand")
    Draaitabel_veld.Orientation = xlColumnField

    'Nu moeten we nog de omzet toevoegen aan de juiste maand en hierbij wil ik graag de som van de omzet zien
    With Draaitabel.PivotFields("Omzet")
        .Orientation = xlDataField
        .Function = xlSum
        .NumberFormat = "#,##0"
        .Position = 1
    End With
    
    'Tot slot zetten we de handmatige update weer uit en mag Excel gaan rekenen


    Draaitabel.ManualUpdate = False


End Sub
 
Vergeet die code. Een draaitabel hoef je maar 1 keer te maken; VBA is daarvoor overbodig.

De draaitabellen in mijn bestand komen overeen met de gegevens die in dezelfde kolommen bovenaan staan.
Je kunt met de hand 10 van deze draaitabellen maken.
Zo gauw je gegevens bovenaan hebt ingevuld hoef je alleen maar de knop 'refresh' te gebruiken en je bent zonder enige VBA klaar.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan