Samenvoegen en optellen middels een macro

[Enigmasmurf]

O jawel, dat is ook nog op te lossen (maar toevallig is dat niet...).
Vanaf versie 4 werkt het
(tussen haakjes: ik heb voor de gegevensvalidatie bij wijze van voorbeeld een écht tabelletje op een ander blad gezet, dan breidt het zichzelf uit als je aanvult)

 

[xmir]

O jawel, dat is ook nog op te lossen (maar toevallig is dat niet...).
Vanaf versie 4 werkt het
(tussen haakjes: ik heb voor de gegevensvalidatie bij wijze van voorbeeld een écht tabelletje op een ander blad gezet, dan breidt het zichzelf uit als je aanvult)

Bijna....de opmaak van H wordt nog vernacheld. Zie voorbeeld. Na uitvoeren wordt de hele kolom grijs en wordt alle tekst zwart....

 

[VenA]

Is al dat quoten nodig? Het maakt het nogal onleesbaar. Volgens mij is jouw werkblad corrupt. Qua code is dit voldoende

Sub VenA()
  With Cells(2, 7).CurrentRegion
    ar = .Value
    .Offset(1).ClearContents
    Set d = CreateObject("Scripting.Dictionary")
    For j = 2 To UBound(ar)
      d(ar(j, 1)) = d(ar(j, 1)) + ar(j, 2)
    Next j
    .Offset(1).Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
  End With
End Sub

 

[xmir]

Sorry voor het quoten VenA...ik zal het niet meer (zo vaak) doen .
Jou code werkt bijna perfect...hij maakt alleen tekst van de valuta (H) en plaatst de bedragen dus links en ik krijg er een uitroepteken bij. Bovendien telt hij ze dan onderaan de streep niet meer op.
Heb je daar misschien nog een oplossing voor?

 

[VenA]

Mogelijk nog even jouw aangepaste celeigenschappen aanpassen.

d(ar(j, 1)) = [COLOR="#FF0000"]CDbl([/COLOR]d(ar(j, 1)) + ar(j, 2)[COLOR="#FF0000"])[/COLOR]

 

[xmir]

Wouw dat is hem! Super blij mee dank je wel VenA voor deze mooie oplossing maar natuurlijk ook Enigmasmurf voor al je moeite! Ik vind dit toch wel een mooiere oplossing als die ik eerder had met draaitabel en macro's!

 

[Enigmasmurf]

de opmaak van H wordt nog vernacheld

Niet voor het een of het ander, maar in de bijlage die ik je stuurde ging dat toch helemaal goed...
Mogelijk heb je mijn code toegevoegd aan je eigen bestand waar al wat raars met de (misschien onzichtbare) opmaak aan de hand was.
Inhoudelijk is er overigens weinig relevant verschil tussen de code van VenA en die van mij.
Nu ja: het belangrijkste is dat je definitief tevreden bent !

 

[VenA]

@Enigmasmurf,

Inhoudelijk is er overigens weinig relevant verschil tussen de code van VenA en die van mij.

Dat het resultaat mogelijk hetzelfde is zal zo zijn maar inhoudelijk zijn er wel zeer grote relevante verschillen.

 

[xmir]

Het ging niet helemaal goed..het voorbeeld wat ik erbij deed was jou bestand. In mijn eigen origineel gaat het nu ook goed en daar was/is niks raars mee maar er zitten verwijzingen in en dan lijken dingen natuurlijk crapy in zo'n voorbeeldbestandje (denk ik?). Hoe dan ook heb ik aan mijn origineel nu verder niks veranderd en werkt het dus ik ben heel blij met jullie beider hulp! Ik had het onderwerp al gesloten toen ik dacht het met een draaitabel en macro's te moeten doen....dat werkte ook maar ik vind dit veel mooier! DANK!!

 

[Enigmasmurf]

@ VenA,

Dat het resultaat mogelijk hetzelfde is zal zo zijn maar inhoudelijk zijn er wel zeer grote relevante verschillen

Ik hoop maar dat je met "mogelijk" niet bedoelt dat volgens jou mijn methode enkel per ongeluk werkt (?)
Verder geven we waarschijnlijk een andere invulling aan de betekenis van het woord "inhoudelijk". We doen toch net hetzelfde (inderdaad op een andere manier), niet?
De 'kritiek' van TS over de opmaak gaat helemaal mijn verstand te boven. In een range waar gegevens van plaats veranderen lijkt een verschillende opmaak per rij minstens contradictorisch.
In een deftige basisopzet zou ik een identieke opmaak per rij, eventueel aangevuld met VO, verwachten.
Hoe zou mijn werkwijze dan verkeerd kunnen gaan ? (vroeg hij op retorische wijze)

Het ligt ook niet in mijn bedoeling om hier een uitgebreid debat over te gaan voeren.
De belangrijkste reden om dit nog even te openen is namelijk: er zit nog een foutje in mijn (ik sta altijd op de eerste rij om dat spontaan toe te geven) én in jouw oplossing. Bij mij zal dat een foutmelding veroorzaken, bij jou zal het (maar niet onherstelbaar) in de soep draaien, meer bepaald wanneer ook G21 gegevens bevat.
Vermits jouw oplossing duidelijk de voorkeur genoot blijf ik er verder liever af (tenzij op uitdrukkelijk verzoek )

 

[VenA]

@Enigmasmurf,

Ik hoop maar dat je met "mogelijk" niet bedoelt dat volgens jou mijn methode enkel per ongeluk werkt (?)

Nee dat bedoelde ik niet. Ik bedoelde zonder de code te testen.
Ook al is het resultaat hetzelfde toch zijn de verschillen in de code inhoudelijk wel groot. In dit bestandje merk je het niet maar hoe minder interactie met een werkblad hoe sneller de code. De wisselende opmaak had ik in eerste instantie ook niet gezien vandaar mijn opmerking in #23 'Volgens mij is jouw werkblad corrupt'

Om het niet in de soep te laten draaien kan het bv zo.

Sub VenA()
  With Cells(2, 7).CurrentRegion
    ar = .Value
    .Offset(1)[COLOR="#FF0000"].Resize(Cells(Rows.Count, 7).End(xlUp).Row - 3)[/COLOR].ClearContents
    Set d = CreateObject("Scripting.Dictionary")
    For j = 2 To UBound(ar)
     [COLOR="#FF0000"]If ar(j, 1) <> "totaal"[/COLOR] Then d(ar(j, 1)) = CDbl(d(ar(j, 1)) + ar(j, 2))
    Next j
    .Offset(1).Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
  End With
End Sub

Of om niet afhankelijk te zijn van het woordje 'totaal'

Sub VenA()
  With Cells(2, 7).CurrentRegion
    ar = .Value
    .Offset(1).Resize(Cells(Rows.Count, 7).End(xlUp).Row - 3).ClearContents
    Set d = CreateObject("Scripting.Dictionary")
    For j = 2 To Application.Min(UBound(ar), Cells(Rows.Count, 7).End(xlUp).Row - 2)
     d(ar(j, 1)) = CDbl(d(ar(j, 1)) + ar(j, 2))
    Next j
    .Offset(1).Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
  End With
End Sub

 

[xmir]

Bedankt voor het meedenken! Ik ga een van de twee nog toepassen om het niet in de soep te laten lopen!