sommeren per postcode

[sickofitall]

Hallo

ik heb een groot bestand met allemaal faxnummers (kolom A), postcodes (kolom B) en andere gegevens (kolom D).

Nu zou ik een macro moeten schrijven die per postcode de som geeft van de waarden in kolom D; en de daarbijhorende faxnummer. (Dit mag in een apart werkblad komen)

Ik ben eraan begonnen en wat geprobeerd maar ik snap er niets van.

bijgevoegd een testbestandje: op werkblad 1 de gegevens en op werkblad 2 heb ik erbij gezet hoe het eruit zou moeten zien. In de modules zul je dus mijn gepruts zien

hopend op enkele genieën! bij voorbaat dank!!

 

[Roncancio]

Iets snap ik niet:
Waarom een macro?

Via onderstaande formules krijg ik dezelfde resultaten: voor de 1e postcode
=SOMPRODUCT((Blad1!A2:A24=A2)*(Blad1!D224))
=SOM.ALS(Blad1!A1:A24;Blad2!A2;Blad1!D124)

Met vriendelijke groet,


Roncancio

 

[Marrosi]

Misschien met een Pivot Table?


MVG - Marrosi

 

[sickofitall]

Iets snap ik niet:
Waarom een macro?

Via onderstaande formules krijg ik dezelfde resultaten: voor de 1e postcode
=SOMPRODUCT((Blad1!A2:A24=A2)*(Blad1!D224))
=SOM.ALS(Blad1!A1:A24;Blad2!A2;Blad1!D124)

Met vriendelijke groet,


Roncancio

het is een zodanig uitgebreid bestand (gegevens over meerdere werkbladen, maar ik wil met 1 werkblad beginnen) en ik moet de gegevens samengevat krijgen. Daarna moet ik deze gegevens automatisch in een brief kunnen zetten (in word of excel).

Dus ik probeer dat met een macro zodat de volgende stappen makkelijker zouden zijn.
Ik ga dit in de toekomst immers meerdere keren per maand moeten doen; en dit excel bestand wordt dan ook elke keer vernieuwd; mijn macro zou dan niet gewist worden maar alle gegevens (en formules wel)

Een draaitabel zou wel handig zijn, moest ik hier geen verdere bewerkingen mee willen uitvoeren.

 

[snb]

Toegepast op Antwerpen:

Sub updaten()
  With Sheets(1).Range("A1").CurrentRegion
    .AutoFilter 2, "=2000"
    .SpecialCells(xlCellTypeVisible).Cells(2, 1).Resize(, 3).Copy Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = WorksheetFunction.Sum(.SpecialCells(xlCellTypeVisible).Columns(4))
  End With
End Sub

 

[sickofitall]

ok ik ben er bijna

dit is wat ik nu heb

Sub updaten()

Dim lrij1 As Long
Dim lrij2 As Long

Dim lsom As Long
Dim lpc As Long


Sheets("Blad1").Select


lrij1 = 2
'Do While Cells(lrij1, 2).Value <> ""

Do While Cells(lrij1, 2).Value = Cells(lrij1 + 1, 2).Value

lsom = lsom + Cells(lrij1, 4).Value

lrij1 = lrij1 + 1

Loop

lrij2 = 2

Sheets("lijst").Cells(lrij2, 1).Value = Sheets("Blad1").Cells(lrij1, 1).Value
Sheets("lijst").Cells(lrij2, 2).Value = Sheets("Blad1").Cells(lrij1, 2).Value
Sheets("lijst").Cells(lrij2, 3).Value = Sheets("Blad1").Cells(lrij1, 3).Value
Sheets("lijst").Cells(lrij2, 4).Value = lsom

lrij2 = lrij2 + 1

'Loop


End Sub

Dit werkt momenteel enkel voor de eerste postcode. Als de postcode verandert gebeurt er nog niets. Als ik de ' voor mijn eerste Do While (en mijn Loop) weghaal, dan loopt de macro echter vast. Iemand nog een idee hoe ik dit oplos??

(ik ben er bijna)

 

[sickofitall]

Toegepast op Antwerpen:

Sub updaten()
  With Sheets(1).Range("A1").CurrentRegion
    .AutoFilter 2, "=2000"
    .SpecialCells(xlCellTypeVisible).Cells(2, 1).Resize(, 3).Copy Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(1)
    Sheets(2).Cells(Rows.Count, 1).End(xlUp).Offset(, 3) = WorksheetFunction.Sum(.SpecialCells(xlCellTypeVisible).Columns(4))
  End With
End Sub

sorry, daar snap ik echt niets van
kun jij mij toevallig niet helpen met mijn codering?

 

[sickofitall]

het is mij dus ondertussen zelf gelukt.

voor de geïnteresseerden:

Sub updaten()

Dim lrij1 As Long
Dim lrij2 As Long
Dim lsom As Long
Dim swb As String

lrij2 = 2
lrij1 = 2
 
'het door de gebruiker opgegeven werkblad selecteren
swb = InputBox("Welk werkblad?", "Update", "Blad1")
Sheets(swb).Select

    'het hele werkblad aflopen tot er geen postcode meer is ingevuld
    Do While Cells(lrij1, 2).Value <> ""

        'de som maken voor dezelfde postcodes
        Do While Cells(lrij1, 2).Value = Cells(lrij1 + 1, 2).Value
        lsom = lsom + Cells(lrij1, 4).Value
        lrij1 = lrij1 + 1
        Loop

    'werkblad lijst invullen
    Sheets("lijst").Cells(lrij2, 1).Value = Sheets("Blad1").Cells(lrij1, 1).Value
    Sheets("lijst").Cells(lrij2, 2).Value = Sheets("Blad1").Cells(lrij1, 2).Value
    Sheets("lijst").Cells(lrij2, 3).Value = Sheets("Blad1").Cells(lrij1, 3).Value
    Sheets("lijst").Cells(lrij2, 4).Value = lsom

    lrij2 = lrij2 + 1
    lrij1 = lrij1 + 1
    lsom = 0

    Loop

Sheets("lijst").Select

End Sub

 

[Roncancio]

Wellicht ten overvloede kan ik nog toevoegen dat je ipv Cells(1,2) ook de kolomletter kan gebruiken aangezien de kolom toch niet verandert.
Dus
- Cells(lRij,"A")
- Range("A" & lRij)

Met vriendelijke groet,


Roncancio