autonummer zoeken

[Rene046]

Hoi.

ben op zoek naar een voorbeeld macro die het volgende kan.

heb een formulier die ik in een tekst vak die ik in een specefieke tab wil laten zoeken
in die tab staat een lijst met nummers 12xxx bv.

12001 tot 12400

hier en daar zijn er een paar tussenuit. verwijderd door gebruiker

wat de macro zou moeten kunnen doen is als er geen nummer hier tussen weg is gewoon
het eerst volgende nummer te geven bv. 12401 in dit geval.
of als er een nummer weg is me deze te geven.

is eigenlijk 2 dinge tegelijk of kan het niet.

in ieder geval bedankt voor het lezen, en moeite voor alle hulp super forum.

leer met de dag meer.

groetjes Rene

 

[Ginger]

Rene046, Zet deze code...

Sub VindOntbrekendGetal()
Dim i As Integer, z As Integer, iVerschil As Integer

    Range("A1").Select
    
    i = 1
    z = 1
    
    Do Until Cells(i, 1).Value = ""
        iVerschil = Cells(i + 1, 1).Value - Cells(i, 1).Value
        If iVerschil > 1 Then
            For y = 1 To iVerschil - 1
                Cells(z, 3).Value = Cells(i, 1).Value + y
                z = z + 1
            Next y
        End If
        i = i + 1
    Loop

    If z = 0 Then
        MsgBox "Geen ontbrekende getallen gevonden!"
    Else:
        MsgBox "Er zijn " & z & " ontbrekende getallen gevonden en geregistreerd!"
    End If

End Sub

...in een module van je VBE. In dit voorbeeld staan de gegevens in kolom A. De code schrijft ieder gevonden item weg in kolom C.

Het is gebouwd met 2 lussen. De 1e kijkt steeds naar de huidige cel en de cel eronder in de gegevenslijst. Als er meer dan 1 verschil zit tussen die twee gaat de 2e lus in werking. Die telt per rondgang 1 op bij de waarde van de actieve cel. Deze wordt dan weggeschreven in kolom C. Als het totale verschil bereikt is, wordt de lus verlaten en de rest van kolom A getest totdat de activecell.value leeg is... (deze code had nog opgezet kunnen worden met een Array die je dan in 1 keer wegschrijft naar kolom C, maar dat werd me ff teveel...).

Groet, Leo

 

[Rene046]

Hoi Ginger.

had zelf dit nu gemaakt, maar mis alleen nog dus het gedeelte waar hij zoekt naar een missend getal.

Sub rtest()
Sheets("blad3").Select
    Dim rng As Range
        Set rng = Sheets("blad3").Cells(Rows.Count, "A").End(xlUp)
            If rng = "" Then
                rng = 12000
            Else: rng.Offset(1).Value = rng.Value + 1
            End If
End Sub

deze routine zoekt gewoon laaste getal en set cell eronder opvolgend getal.
zeg maar standaard autonummering.

dus eigenlijk moet een andere routine kijken of het verschil niet meer dan 1 is en dan dat misende getal onder aan in de lijst zetten.

en ik weet nog niet hoe ik hem vanaf A3 inplaat A1 kan laten zoeken.
heb geprobeert A te vervangen met A3:A maar dat werkte niet.

Zodra ik genoeg geld heb wil ik me toch eens eens goed boek kopen. hahaha

 

[Ginger]

Rene046, prima dat je zelf bent bezig geweest!:thumb: Maareh... heb je mijn code nu wel geprobeerd? Die werkt namelijk prima! Neem die anders als basis om verder te klussen.

Hmmm... wel opletten! Je moet niet willen dat de code je ontbrekende getallen onderaan je gegevenslijst zet, anders zal je in een flinke oneindige lus belanden. Dus beter om het gewoon in een aparte kolom te zetten (doet mijn code) en dan die getallen na afloop onder je lijst plakken en de hele lijst sorteren.

Groet, Leo

Ps. wel heel belangrijk is het om de code in een GESORTEERDE lijst te laten zoeken. Anders gaat het ook flink mis!

 

[Wigi]

Voer dit eens uit

Sub VindOntbrekendGetal()

    Dim rCell As Range
    Dim rToSeek As Range
    Dim i As Integer
    
    Set rToSeek = Intersect(Columns(1), ActiveSheet.UsedRange)
    
    Range("D1") = "ontbrekende nrs"
    
    For i = 1 To WorksheetFunction.Max(rToSeek)
        Set rCell = rToSeek.Find(what:=i, lookat:=xlWhole, LookIn:=xlValues)
        
        If rCell Is Nothing Then
            Range("D" & Rows.Count).End(xlUp).Offset(1).Value = i
        End If
    Next

End Sub

Ik neem hierbij aan dat de gegevens in kolom A staan.

Wigi

 

[Ginger]

Wigi, Een kleine aanpassing was nodig in je code. De lijst begint namelijk bij 12001...

in die tab staat een lijst met nummers 12xxx bv.

12001 tot 12400

In jouw geval vindt ie dus alles vanaf 1 t/m 12000. Ik heb de variabele y toegevoegd

Dim i As Integer, y As Integer

Set rToSeek = Intersect(Columns(1), ActiveSheet.UsedRange)

Range("D1") = "ontbrekende nrs"

y = Range("A1").Value

For i = y To WorksheetFunction.Max(rToSeek)

(ff tussen quote-tags om eea met kleur aan te kunnen geven)
De aanname is hierbij ook dat de lijst in cel A1 begint...

Groet, Leo

P.s. Is jouw code beter dan de mijne? Of is de jouwe gewoon 'ook een manier'? (dit als 'leervraag')

 

[Wigi]

Jij gaat ervan uit dat er gesorteerd werd, bij mij niet. Dat is het belangrijkste verschil.

 

[Rene046]

Hoi Wigi.


Dat werkt zover bijna perfect. heb van For i = 1 To > For i = 12000 To
gemaakt.
wat hij nu eigenlijk zou moeten doen is kijken zoals jij zegt in kolom A

verder zoeken tot het einde laaste
hij zal dan geen, 1 of meerdere nummer missen.

wat hij dan moet doen is als hij geen nummer mist gewoon op het einde van de A kolom
een nieuw nummer zetten 12401 niet in cel D1

of als hij een nummer(s) mist de eerste op het einde zetten. niet zoals nu alle nummers

wat dus erg belangrijk is is dat hij de heele reeks afloopt omdat de nummers dus doorelkaar in die lijst kunnen voorkomen. b.v.> anders zou hij dubble nummer maken wat niet mag gebeuren.

12000
12001
12002
12005
12006
12003

ik weet het is erg ingewikkeld, maar zoals ik zie hoe snel je al een oplossing gevonden hebt, ben je wel erg goed hierin.

 

[Rene046]

Hoi Leo,


Jip ik had je berichtje nog niet gelezen, maar ik had dat al uitgevogeld. en heb er dus gewoon 12000 ingevuld.


maar fijn dat je dat ook gezien hebt en het dus al ongeveer begrijpt.

dus nummers die in die A rij dus mogen en kunnen voorkomen zijn maximaal
12000 (dit is bij mij een nummer dat er altijd een rij staat maar dan zonder gegevens.) tot 12999.

dus kan 999 objecten in de lijst plaatsen.
die nummers kunne doorelkaar heen in de lijst komen, omdat soms een product stuk gaat
en verwijderd wordt, en als iemand tijd heeft een nieuwe erin zet, en dat deze gewoon op het einde erin komt, of een oude plaats vervangt.

heb ook een tab met producten die met een 13xxx of 14xxx beginnen
was mijn iedee niet on producten in te delen met een nummer maar ja ...het is niet anders.

 

[Ginger]

Ok! Pas dan nog die keiharde 12000 aan in deze variabele...

Verander in mijn antwoord aan Wigi deze regel

y = Range("A1").Value

in

y = WorksheetFunction.Min(rToSeek)

Dan weet je in een ongesorteerde lijst ook wat de onderwaarde is!

Groet, Leo

 

[Rene046]

ok ik heb er dus nu dit van gemaakt.

Dim i As Integer, y As Integer

    
    Set rToSeek = Intersect(Columns(1), ActiveSheet.UsedRange)
    
    Range("D1") = "ontbrekende nrs"
    y = WorksheetFunction.Min(rToSeek)
    For i = WorksheetFunction.Min(rToSeek) To WorksheetFunction.Max(rToSeek)

en het werkt ook goed

 

[Rene046]

hee ,

ik zie dat ik dus eigenlijk

y As Integer en y = WorksheetFunction.Min(rToSeek) weg kan laten.. jongens het wordt nog wat met me..

 

[Rene046]

schijnt dat dit toch erg lastig is.

hoop dat jullie er wat op vinden

grtz Rene

 

[Ginger]

Rene046, Nou... dan helpen we je toch weer gewoon een stukje verder....
Plak deze code in een module, en je hele wens wordt waarheid!

Sub VindOntbrekendGetal3()
'variatie op code van Ginger... door Wigi (zoeken mag in ongesorteerde lijst); 25/10/2007
'bijgewerkt door Ginger (ontbrekende getallen worden onder de lijst geplaatst); 26/10/2007
    Dim rCell As Range
    Dim rToSeek As Range
    Dim i As Integer, y As Integer, z As Integer, x As Integer
    Dim lLastCell As Long
    
    '####################################################################################
    Const iKolNrBron As Integer = 6 'geef hier het kolomnummer van de te doorzoeken lijst
    '####################################################################################
    
    lLastCell = Cells(65536, iKolNrBron).End(xlUp).Row
    
    Set rToSeek = Intersect(Columns(iKolNrBron), ActiveSheet.UsedRange)
    
    x = 0 'de teller van de gevonden ontbrekende getallen
    y = WorksheetFunction.Min(rToSeek) 'onderste waarde in lijst
    z = WorksheetFunction.Max(rToSeek) 'bovenste waarde in lijst
    
    For i = y To z
        Set rCell = rToSeek.Find(what:=i, lookat:=xlWhole, LookIn:=xlValues)
        
        If rCell Is Nothing Then
            x = x + 1
            Cells(lLastCell + x, iKolNrBron).Value = i
        End If
    Next

    If x = 0 Then
        MsgBox "Geen ontbrekende getallen gevonden!"
    Else:
        MsgBox "Er zijn " & x & " ontbrekende getallen gevonden en geregistreerd!"
    End If
    
End Sub

Let ff op dit stukje 'iKolNrBron As Integer = 6' in de code. Verander die '6' in het kolomnummer waar JIJ je lijst hebt staan.

Enne...

jongens het wordt nog wat met me..

...Tuurlijk! Als je je best maar blijft doen!

Groet, Leo

 

[Rene046]

Hoi Leo,


zover werkt het alleen zet hij nog steeds alle ontbrekende nummer onderaan op de kolom.
hij hoeft alleen de eerste van de lijst van ontbrekende numers hierin te plaatsen, en als er geen ontbrekende nummers zijn gewoon standaard eentje verhogen (autonumering zeg maar)

 

[Ginger]

Rene046, Ik begin je een beetje kwijt te raken...
Wil je nu WEL of NIET de ontbrekende nummers onderaan je lijst hebben?

Ooooo... Wacht ff... Bij het nalezen van al je posts denk ik ineens te weten wat je wilt! Je wilt iets van een knop in je sheet hebben die de gebruiker kan aanklikken als hij een nieuw nummer moet gaan invoeren. De code moet dan vervolgens kijken of er nummers onbreken en zo ja, het 1e ontbrekende nummer geven. Zo nee, geef de hoogste uit de lijst + 1

Ik zal ff kijken of ik 't voor je kan aanpassen.

Groet, Leo

P.s. Probeer trouwens zo duidelijk mogelijk nederlands te schrijven. 't Is af en toe een behoorlijk zoekplaatje!

 

[Ginger]

Rene046, Dan zou DIT het gewenste resultaat moeten opleveren...

Sub VindOntbrekendGetal4()
'variatie op code van Ginger... door Wigi (zoeken mag in ongesorteerde lijst); 25/10/2007
'bijgewerkt door Ginger (1e ontbrekende getal wordt onder de lijst geplaatst -> indien er geen _
 ontbrekend getal is wordt de hoogste waarde met 1 verhoogd); 26/10/2007
    Dim rCell As Range
    Dim rToSeek As Range
    Dim i As Integer, y As Integer, z As Integer, x As Integer
    Dim lLastCell As Long
    
    '####################################################################################
    Const iKolNrBron As Integer = 13 'geef hier het kolomnummer van de te doorzoeken lijst
    '####################################################################################
    
    lLastCell = Cells(65536, iKolNrBron).End(xlUp).Row
    
    Set rToSeek = Intersect(Columns(iKolNrBron), ActiveSheet.UsedRange)
    
    y = WorksheetFunction.Min(rToSeek) 'onderste waarde in lijst
    z = WorksheetFunction.Max(rToSeek) 'bovenste waarde in lijst
    
    For i = y To z
        Set rCell = rToSeek.Find(what:=i, lookat:=xlWhole, LookIn:=xlValues)
        
        If rCell Is Nothing Then
            Cells(lLastCell + 1, iKolNrBron).Value = i
            Exit Sub
        End If
    Next
    
    Cells(lLastCell + 1, iKolNrBron).Value = z + 1

End Sub

Plaats een knop op je sheet die je verbindt aan deze code (vergeet niet om het juiste kolomnummer in de code te zetten!!!!). Bij iedere druk op de knop wordt er in je lijst gekeken of er waarden ontbreken. Zo ja, geef de 1e ontbrekende in de cel onder de laatste. Zo nee, plaats daar dan de hoogste waarde + 1.

Groet, Leo

 

[Rene046]

Hoi Leo ik zal het proberen uit te leggen.

Straks kan een gebruiker, producten via een knop toe voegen/verwijderen of bewerken.

dit zullen diverse catagorien zijn .. ( verschillende sheets ( cat12xxx. cat13xxx)

nu even een voorbeeld:

12001
12000
12003
12005
12008
12002

stel de gebruiker wil nu een product toevoegen dan zou de macro
in de lijst moeten zoeken welke nummers weg zijn (maar aangezien de nummer
doorelkaar in de lijst kunnen staan moet hij dus zoeken van begin tot het einde
van die kolom. de 12000 is de eerste en de 12008 is de laaste
hier mist dus:
12004
12006
12007
wat hij dan moet doen is de eerste weer onder in de kolom zetten 12004.

maar stel nu de lijst is mooi zonder ontbrekend nummer b.v.

12001
12000
12003
12005
12008
12002
12004
12006
12007

dan zou de macro gewoon een volgend nummer moeten plaatsen 12009 dus.

dat was het verhaal eigenlijk.
ik wil straks als het me lukt een formulier maken
met de volgende knoppen.
-product zoeken & bewerken
-product verwijderen
-product nieuw toevoegen

bij die laaste zou die macro nodig zijn, maar het probleem waar ik nu ook nog over zit te denken is dat stel de gebruiker wil een nieuwe toevoegen dan moet die macro zijn werk doen en de gebruiker moet dat nummer in dat formulier te zijn krijgen zodat hij die kan labelen. of als hij zich bedenkt van nee ik voeg niks toe mag er dus geen nummer.
worden toegevoegt in die catagorie.

ik hoop dat het wat duidelijker is , ander vraag gewoon maar.

ik vind het ook intressant.

en sorry voor mijn slecht limburgs nederlands hahaha heb nooit meer dan een 5 gehad

 

[Rene046]

hahahaha,

zie je wel

jij bent sneller in de oplossing vinden dan ik in het typen van een andwoordt.

zover werkt het even ermee stoeien en situaties testen.

lees mijn text maar even door dan weet je ongeveer wat ik wil gaan doen.

denk dat je me nog wel eens kunt helpen met paar andere dingen.
'*******************************************

brilljant dat is nu precies wat ik bedoelde. je bent echt super super goed
ongeloofelijk.

wou dat ik dat zo onder de knie krijg, ben helaas niet zo goed met het begrijpen van ding in de uitleg, heb meer aan de praktijk voorbeelden.

nu moet ik alleen nog een knop zien te maken voor in een formulier die me dus dat nummer opzoekt in een tekst veld laat zien, en dan de gegevens die ik in andere tekst vaken in vul die opslaat op een rij met dat nummer.

heel heel erg bedankt.

 

[Ginger]

Rene046, Die laatste code kan je prima gebruiken voor een VBA userform. Je moet 'm dan alleen van een 'sub' in een 'functie' veranderen. Daarna handel je met de (te plaatsen) knoppen op het form het wegschrijven in je sheet(s) af. Dus als de gebruiker dan tijdens de invoer op dat form zich bedenkt en op 'cancel' of 'het kruisje' klikt, wordt er ook niets weggeschreven.

Enne...

en sorry voor mijn slecht limburgs nederlands hahaha heb nooit meer dan een 5 gehad

Dat maakt niet uit! Als je het maar zo probeert te omschrijven dat de oplosser over je vraagstelling in iedergeval géén vragen heeft...

Groet, Leo

P.s. succes met de verdere ontwikkeling van je workbook
P.s.2 Als de oplossing naar tevredenheid is, deze topic aub afsluiten!