• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

VBA code

Status
Niet open voor verdere reacties.

JWExcel

Gebruiker
Lid geworden
20 mrt 2015
Berichten
44
Beste mensen,

Voor de deskundige VBA'er is de volgende vraag een eitje.

In de bijlage is een bestand met 2 sheets. Sheet 1. Lijst en 2. Totaal
In sheet 2. Totaal staan in kolom A, 1150 namen van klanten en ik kolom B een productnummer
Een klant kan meerdere productnummers hebben en kan dus meerdere regels in kolom A met zelfde klant naam hebben en in kolom B een andere code.

In sheet 1 Wil ik deze verschillende codes onder elkaar hebben gesorteerd op klant naam. Alfabetische volgorde klant AGCO GmbH heeft maar 1 nummer dat moet in sheet 1 in cel B1 komen. De volgende klant heeft bv 3 nummers die moeten in cel C2 C3 en C4 komen. Enzovoort.

Ik kan dit met de hand doen maar ik heb nog meer bestanden en dan ben ik een aantal duizend keer bezig. Mens = Lui dus VBA :thumb:

Weet iemand de VBA code om dit te doen?

Bij voorbaat dank !!!
 

Bijlagen

Voor de deskundige VBA'er is de volgende vraag een eitje.
Als je dat zo zeker weet dan zou je op zijn minst een klein beetje moeite kunnen doen om je zelf in het probleem te verdiepen en met een aanzet tot een oplossing te starten.
 
toch maar een opzetje:
aangenomen is dat de hoofd lijst al gesorteerd is
zou het overzichtelijker zijn als de klantnamen in de A kolom staan en de producten er naast?
Code:
Sub test()
    Dim Klant As Range, Naam As Range, Plek As Range
    Sheets("1. Lijst").UsedRange.ClearContents
    Set Naam = Sheets("1. Lijst").Range("A1") 'startplaats klantnamen
    Set Plek = Naam.Offset(1, 0) ' en onder de naam is de plek van de producten
    With Sheets("2. Totaal")
        For Each Klant In .Range("A1:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
            If UCase(Klant) = UCase(Naam) Then 'bestaat de naam al ?
                Set Plek = Plek.Offset(1, 0) 'zo ja dan doe de plek 1 cel naar beneden
                Plek = Klant.Offset(0, 1)     ' vul hem in
            Else                               ' nieuwe naam
                Set Naam = Naam.Offset(0, 1)    'schuif de naam 1 cel opzij
                Set Plek = Naam.Offset(1, 0)    'zet de plek er onder
                Naam = Klant                    'vul de naam in
                Plek = Klant.Offset(0, 1)       'vul de plek in
            End If
        Next Klant
        Sheets("1. Lijst").UsedRange.EntireColumn.AutoFit 'kolommen passent maken
    End With
End Sub
 
Laatst bewerkt:
Vba

Ik had inderdaad ook even mijn code moeten toevoegen. Ik had een code wat leek op die van jou sylvester-ponte alleen het gedeelte bij else had ik verkeerd. Je code werkt perfect, heel veel dank hiervoor. Ik ga nu doorlezen hoe dat werkt met offset want dat is nieuw voor me. Bedankt dat je me dit geleerd hebt !

:thumb::thumb::thumb:
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan