sorteren en wegschrijven en ...

[stefano]

Ik beschik over een bestand met verkoopgegevens per vertegenwoordiger. Alles wordt via het programma PowerPlay geëxporteerd naar 1 tabblad in excel. Elke maand moet ik de gegevens uit dat bestand sorteren per vertegenwoordiger en per groep en in aparte excel-documenten plaatsen. Die bestanden worden dan naar de verschillende vertegenwoordigers gemaild.

Mijn grootste probleem is natuurlijk : Hoe pak ik dit BEST aan ?

Ik heb een voorbeeld in bijlage geplaatst zodat alles (hopelijk) duidelijker wordt...

Dank alvast voor diegene(-n) die me op weg helpen.

gr,

Stefano

 

[Demeter]

Denk dat dat een hele klus voor je gaat worden.
- eerst de gegevens overzetten naar de juiste bladen.
- de gegevens layouten.
- bladen wegschrijven naar eigen files (al dan wel met opvolgnummers erbij).

Al deze ingredienten zijn hier op Helpmij te vinden .

Om je op weg te helpen, een stukje (vb) code voor het overzetten van de gegevens (zonder controle slagen etc.):

Sub overzetten()
Dim c, d As Range
Dim p, q As Long

'namen van medewerkers
medewerker1 = "KDR"
medewerker2 = "JDV"
laatstemedewerker = "SRN"

Sheets("uitleg").Activate

'****************************************************************
'zet gegevens eerste medewerker over
    With Range("A1:A" & Sheets("uitleg").Range("A65536").End(xlUp).Row)
        Set c = .Find(medewerker1, LookIn:=xlValues)
        c.Select
        p = (c.Row() + 1)
        Set d = .Find(medewerker2, LookIn:=xlValues)
        d.Select
        q = (d.Row() - 1)
        Sheets(medewerker1).Cells.Clear
        Rows(p & ":" & q).Copy Sheets("KDR").Range("A1")
'****************************************************************
'zet gegevens tweede medewerker over
        Set c = .Find(medewerker2, LookIn:=xlValues)
        c.Select
        p = (c.Row() + 1)
        Set d = .Find(laatstemedewerker, LookIn:=xlValues)
        d.Select
        q = (d.Row() - 1)
        Sheets(medewerker2).Cells.Clear
        Rows(p & ":" & q).Copy Sheets("JDV").Range("A1")
'****************************************************************
'zet gegevens laatste medewerker over
        Set c = .Find(laatstemedewerker, LookIn:=xlValues)
        c.Select
        p = (c.Row() + 1)
        q = Sheets("uitleg").Range("A65536").End(xlUp).Row
        Sheets("SRN").Cells.Clear
        Rows(p & ":" & q).Copy Sheets(laatstemedewerker).Range("A1")
    End With
End Sub

Nog wat extra vragen:
- Hoeveel werknemers zijn er?
- Hoeveel verschillende klanten kan een werknemer hebben?

 

[stefano]

Hoeveel werknemers er zijn ? Zoveel als er in dienst zijn, is variabel , maar in het bestand dat ik maandelijks krijg staat na de naam van de eerste vertegenwoordiger, layer 1/xx en die xx vertegenwoordigt dan het aantal vertegenwoordigers voor de betrokken maand.

Aantal klanten ( waaraan verkocht werd in die maand ) is zeer variabel. Dit kan gaan van effectief 0 tot 4 à 500.

Alvast dank voor de aanzet. Ik probeer al iets in elkaar te 'stampen'.

 

[Demeter]

Code in voorbeeld verwerkt.
Zie attachment

 

[Demeter]

Nu rest alleen nog saven als verschillende bladen.
Maar daar heb je het gehele weekend voor om uit te zoeken.
Misschien kan de code nog wat efficienter maar hierbij laat ik het even .

Check het attachmentje.

 

[stefano]

foutmelding

In onderstaande code staat een fout. Bedoeling is enkele lijnen in een andere kleur te zetten. De twee lijnen Dim boven as Long en Dim onder as long heb ik er zelf bijgezet , want anders krijg ik een compileerfout ( een variabele is niet gedefiniëerd ) . Wat doe ik verkeerd ?


Sub roze_lijnen()
Dim c As Range
Dim x As Long
Dim boven As Long
Dim onder As Long

Range("A11").Resize(1, 6).Interior.ColorIndex = 36

For x = 11 To Range("A65536").End(xlUp).Row
boven = Left(Range("A" & x), 2)
onder = Left(Range("A" & x + 1), 2)
If boven <> onder Then
Range("A" & x).Offset(1).Resize(1, 6).Interior.ColorIndex = 36
End If
Next

End Sub

 

[Wigi]

Werkt dit wel?

Sub roze_lijnen()
    Dim x As Long
    Range("A11").Resize(, 6).Interior.ColorIndex = 36
    For x = 11 To Range("A" & Rows.Count).End(xlUp).Row - 1
        If Val(Left(Range("A" & x), 2)) <> Val(Left(Range("A" & x + 1), 2)) Then Range("A" & x + 1).Resize(, 6).Interior.ColorIndex = 36
    Next
End Sub

Wigi

 

[Wigi]

Zet in je berichten, als je code plaatst, code tags rond je code. Laat wel de ' weg in ['code] en ['/code].