Totaal per leverancier optellen en wegschrijven op blad2

[jefkeh]

Hoi,
In blad1 heb ik een lijst met leveringen per persoon, in kolom H staan de personen en in kolom I het totaal.
Nu had ik graag een macro welke in blad1 de totalen per persoon optellen( in vb: alle totalen van jef optelt) naar blad2 gaat de eerste lege regel onder leverancier selecteert en daar de naam van persoon en totaal wegschrijft.
Dit tot elke persoon uit lijst is gedaan, zodat ik in blad2 een overzicht krijg per persoon.
Als ik in blad1 iets toevoeg zou dit aut. moeten bijgewerkt worden.
Het kan zijn dat er al ergens in het forum zoiets staat maar kan het niet direkt vinden.
Alvast bedankt.

 

[HSV]

Met een macrootje.

Sub hsv()
Dim sn, i As Long
 sn = Blad1.Columns(8).SpecialCells(2).Resize(, 2)
With CreateObject("scripting.dictionary")
  For i = 2 To UBound(sn)
   .Item(sn(i, 1)) = .Item(sn(i, 1)) + sn(i, 2)
  Next i
 Blad2.Cells(4, 2).Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
End With
End Sub

 

[Cobbe]

Dat kan ook makkelijk zonder vba.

 

[VenA]

Maak van de invoer een tabel en gebruik een draaitabel. Eventueel met code omdat het om een VBA vraag gaat.

Private Sub Worksheet_Activate()
    Application.ScreenUpdating = False
    ThisWorkbook.RefreshAll
End Sub

 

[jefkeh]

Hey mannen,

Bedankt voor de super snelle reactie, ik ga deze in mijn bestand plaatsen en dan zien we wel.
Laat nog iets horen
Gr.

 

[jefkeh]

Hoi HSV,
Als ik uw macro toepas op mijn groot bestand krijg ik volgende foutmelding
"object vereist"
op wat slaat dat, wat moet ik wijzigen?

Sub hsv()
Dim sn, i As Long
sn = Aankopen.Columns(10).SpecialCells(2).Resize(, 2)
With CreateObject("scripting.dictionary")
For i = 2 To UBound(sn)
.Item(sn(i, 1)) = .Item(sn(i, 1)) + sn(i, 2)
Next i
Algoverzicht.Cells(7, 8).Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
End With
End Sub


Die oplossingen zonder macro werkt perfect, maar ik wou toch naar de macro gaan omdat dit beter past in mijn bestand.

Alvast bedankt.

Sorry voor het laattijdig reageren naar ben er effen tussen uitgeweest.

 

[Cobbe]

De bladen Aankopen en/of Algoverzicht zullen niet aanwezig zijn of toch niet onder deze namen.

 

[Warme bakkertje]

In de macro van HSV is Blad1 de codenaam v/h werkblad (de naam die niet tussen haakjes staat in het linkervenster van de VBEditor.
Als het de werkelijke namen van je werkbladen zijn gebruik je Sheets("Aankopen") en Sheets("Algoverzicht")

 

[jefkeh]

Ik heb deze namen aangepast en dat gaat goed.
Maar het lukt nog steeds niet en ik denk dat het te maken heeft met de aantal koloms,
in mijn bestand ga ik naar kolom10 en dat gaat niet, als ik dit wijzig naar minder dan 8 gaat het wel.
Is dit op te lossen?

Dank u

 

[Cobbe]

Probeer het zo:

Sub hsv()
 Dim sn, i As Long
  sn = Sheets(1).Columns(8).SpecialCells(2).Resize(, 2)
   With CreateObject("scripting.dictionary")
 For i = 2 To UBound(sn)
   .Item(sn(i, 1)) = .Item(sn(i, 1)) + sn(i, 2)
 Next i
   Sheets(2).Cells(4, 2).Resize(.Count, 2) = Application.Transpose(Array(.keys, .items))
 End With
End Sub

 

[jefkeh]

Hoi,
Het is me gelukt, het werkt, de fout lag aan mij.
Nogmaals bedankt voor de hulp mannen.
Gr.