• 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.

Automatisch volgnummer m.b.v. macro

Status
Niet open voor verdere reacties.
Gert Bouwmeeste

Gert Bouwmeeste

Verenigingslid
Lid geworden
28 nov 2007
Berichten
827
Ik zou graag in een cel in kolom A met een macro een oplopend volgnummer genereren. Het is een lijst met ordernummers met als syntax "2011-0001" enz. Werken met MAX kan niet omdat het geen getal is maar alfanumeriek. En er een getal van maken kan ook niet omdat het later ingelezen wordt in een database die dat niet accepteert.

Ik zou graag in een lege cel op bv CTRL + Q willen drukken en dat dan het eerstvolgende vrije nummer verschijnt, dat hoeft dus niet persé het hoogste nummer plus 1 te zijn. Er kan ook een order wegvallen in de reeks zodat dat ordernummer weer vrijkomt.

Zie bijgaand bestandje voor een voorbeeld.
 

Bijlagen

Gert,

De volgende matrixformule lost dit op:
Code: 
=ALS(ISLEEG(B70);"";"2011-"&HERHALING(0;4-LENGTE(MAX(RECHTS($A$42:A69;VIND.SPEC("-";$A$42:A69;1)-1)+1)))&MAX(RECHTS($A$42:A69;VIND.SPEC("-";$A$42:A69;1)-1)+1))
Althans, zo krijg je het hoogste nummer. Voorwaarde is wel dat er in de nummerreeks geen lege cellen mogen voorkomen. Een eerder vrijgekomen nummer bereik je hier niet mee.
 
Laatst bewerkt:
rdg1314 zei:
Een eerder vrijgekomen nummer bereik je hier niet mee.
Klik om te vergroten...

Rob, dat klopt. Als een tussenliggend nr verwijderd wordt dan werkt de formule ook niet meer. Ik zit zelf te denken aan een macrotje die een hulpkolom maakt van de laatste 4 cijfers en dan op die manier zoeken. Moet kunnen, er zullen max 1.200 regels/nummers per jaar gebruikt worden. Ik ga morgen wel even aan het knutselen.
 
Het werkt

MDN111, erg bedankt. Ook voor de uitgebreide toelichting in de macro.

Ik heb er nog iets aan veranderd, hjet is meestal zo dat het nieuwe nummer niet aan het einde komt maar ergens tussenin. Dus ik heb
Code: 
mySheet.Cells(myLastRow + 1, 1).Value = "2011-" & Format(NewNumber, "0000")
veranderd in
Code: 
ActiveCell.Value = "2011-" & Format(NewNumber, "0000")

En nu werkt het perfect!
 
Korter en sneller
Code: 
Sub tst()
    On Error Resume Next
    Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Copy [IV1]
    Columns(256).Sort [IV1], xlAscending
    sq = Range("IV1:IV" & Cells(Rows.Count, 256).End(xlUp).Row)
    For i = 1 To UBound(sq)
        If Int(Right(sq(i + 1, 1), 4)) <> Int(Right(sq(i, 1), 4)) + 1 Then
            NewNumber = Int(Right(sq(i, 1), 4)) + 1
            Exit For
        End If
    Next
    Columns(256).Clear
    ActiveCell.Value = "2011-" & Format(NewNumber, "0000")
End Sub
 
Rudi,

Ik krijg een foutmelding Variabele is niet gedefinieerd en daarbij wordt verwezen naar de variabele SQ?

Nadat ik de volgende variabelen heb gedefinieerd:
Code: 
Dim sq As Integer
Dim i As Integer
Dim NewNumber As Long
krijg ik een foutmelding Er wordt een matrix verwacht bij
Code: 
For i = 1 To UBound(sq)

Enig idee?

Groet, Gert
 
Ik verwachtte het al :D
Waarschijnlijk heb je bovenaan je module Option Explicit staan.
Zet bovenaan de macro
Code: 
Dim sq as range, i as integer, NewNumber as integer
 
korter en met een matrixformule
Code: 
Sub Volgende()
  With Sheets("blad1")
    If ActiveSheet.Name <> .Name Then MsgBox "je staat niet in het juiste blad": Exit Sub  'je moet in het juiste blad staan
    Dim bereik As String, c As Range
    Set c = .Range("A" & Rows.Count).End(xlUp).Offset(1)   'eerstvolgende lege cel
    bereik = c.Offset(1 - c.Row).Resize(c.Row - 1).Address  'alle bovenliggende cellen
    c.Value = "2011-" & Format(Evaluate("=MAX(IF(ISNUMBER(--RIGHT(" & bereik & ",4)),--RIGHT(" & bereik & ",4),0))") + 1, "0000")  'volgende volgnummer
  End With
End Sub
 
Code: 
Dim sq as range, i as integer, NewNumber as integer
Klik om te vergroten...

Heb ik gedaan. Alle overige macro's weggehaald. Deze macro geeft nu nog de foutmelding Er wordt een matrix verwacht bij
Code: 
For i = 1 To UBound(sq)
 
cow18 zei:
korter en met een matrixformule
Code: 
Sub Volgende()
  With Sheets("blad1")
    If ActiveSheet.Name <> .Name Then MsgBox "je staat niet in het juiste blad": Exit Sub  'je moet in het juiste blad staan
    Dim bereik As String, c As Range
    Set c = .Range("A" & Rows.Count).End(xlUp).Offset(1)   'eerstvolgende lege cel
    bereik = c.Offset(1 - c.Row).Resize(c.Row - 1).Address  'alle bovenliggende cellen
    c.Value = "2011-" & Format(Evaluate("=MAX(IF(ISNUMBER(--RIGHT(" & bereik & ",4)),--RIGHT(" & bereik & ",4),0))") + 1, "0000")  'volgende volgnummer
[COLOR="blue"]    Activecell.Value = c.Value[/COLOR]
  End With
End Sub
Klik om te vergroten...

Maar dan moet ik wel Activecell.Value = c.Value toevoegen om de waarde in de cel te krijgen. Bovendien doet deze macro alleen het hoogste nummer plus 1 en vult hij geen tussenliggende nummers op, wat wel gewenst is.
 
Code: 
Sub tst()
    Dim sq As Variant, i As Integer, NewNumber As Integer
    On Error Resume Next
    Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).Copy [IV1]
    Columns(256).Sort [IV1], xlAscending
    sq = Range("IV1:IV" & Cells(Rows.Count, 256).End(xlUp).Row)
    For i = 1 To UBound(sq)
        If Int(Right(sq(i + 1, 1), 4)) <> Int(Right(sq(i, 1), 4)) + 1 Then
            NewNumber = Int(Right(sq(i, 1), 4)) + 1
            Exit For
        End If
    Next
    Columns(256).Clear
    ActiveCell.Value = "2011-" & Format(NewNumber, "0000")
End Sub
 
nieuwe versie
Code: 
Sub Volgende()
  With Sheets("blad1")
    If ActiveSheet.Name <> .Name Then MsgBox "je staat niet in het juiste blad": Exit Sub  'je moet in het juiste blad staan
    Dim bereik As String, bereik2 As String, c As Range, Grootste As Integer, Ontbreekt As Integer
    Set c = .Range("A" & Rows.Count).End(xlUp).Offset(1)   'eerstvolgende lege cel
    bereik = c.Offset(1 - c.Row).Resize(c.Row - 1).Address  'alle bovenliggende cellen
    On Error Resume Next
    Grootste = Evaluate("=MAX(IF(ISNUMBER(--RIGHT(" & bereik & ",4)),--RIGHT(" & bereik & ",4),0))")  'grootste volgnummer
    bereik2 = Range("A1:A" & Grootste - 1).Address
    Ontbreekt = Evaluate("=MIN(IF(FREQUENCY(IF(ISNUMBER(--RIGHT(" & bereik & ",4)),--RIGHT(" & bereik & ",4),""""),ROW(" & bereik2 & "))=0,ROW(" & bereik2 & "),99999))")
    ActiveCell.Value = "2011-" & Format(IIf(Ontbreekt = 0, Grootste + 1, Ontbreekt), "0000")
  End With
End Sub
 
en nog eentje om ht af te leren
Code: 
Sub volgende2()
  Dim nrs(1 To 9999) As Integer, i As Integer, c As Range, bereik As Range
  For i = 1 To UBound(nrs): nrs(i) = i: Next               'array vullen met alle nrs
  Set c = Sheets("blad1").Range("A" & Rows.Count).End(xlUp).Offset(1)  'eerstvolgende lege cel
  Set bereik = c.Offset(1 - c.Row).Resize(c.Row - 1)       'alle bovenliggende cellen
  On Error Resume Next
  For Each c In bereik.Cells
    i = CInt(Right(c, 4))                                  'waarde 4 rechtste karakters
    If i > 0 Then nrs(i) = 9999                            'schrap dat nr
  Next
  ActiveCell.Value = "2011-" & Format(WorksheetFunction.Min(nrs), "0000")  'kleinste van de overblijvende nrs met 2011 ervoor
End Sub
 
Het werkt

@warmebakkertje: Rudi, het werkt nu wel (code in #12)

@cow: beide werken.

Nu heb ik dus een luxe probleem. 4 werkende oplossingen. Ik ga maar afwisselen denk ik.

Bedankt allemaal!
 
Dat is mooi, zeg....!

Eerst dacht ik bij mezelf dat ik een mooie macro had geschreven, maar als ik de code zie waarmee jullie op de proppen komen......... Geweldig !!!

Grtz,
MDN111.
 
reactie op volgnummer

Beste Cow 18, stel dat ik jou voorbeeld zou gebruiken en ik heb al een beginnummer hoe zou ik dat dan moeten doen? Ik wil bijvoorbeeld beginnen met K20360.
Zie onder. Hoor graag van je! grt. Wouter

Sub Volgende()
With Sheets("blad1")
Dim bereik As String, bereik2 As String, c As Range, Grootste As Integer, Ontbreekt As Integer
Set c = .Range("A" & Rows.Count).End(xlUp).Offset(1) 'eerstvolgende lege cel
bereik = c.Offset(1 - c.Row).Resize(c.Row - 1).Address 'alle bovenliggende cellen
On Error Resume Next
Grootste = Evaluate("=MAX(IF(ISNUMBER(--RIGHT(" & bereik & ",5)),--RIGHT(" & bereik & ",5),0))") 'grootste volgnummer
bereik2 = Range("A1:A" & Grootste - 1).Address
Ontbreekt = Evaluate("=MIN(IF(FREQUENCY(IF(ISNUMBER(--RIGHT(" & bereik & ",5)),--RIGHT(" & bereik & ",5),""""),ROW(" & bereik2 & "))=0,ROW(" & bereik2 & "),99999))")
ActiveCell.Value = "K" & Format(IIf(Ontbreekt = 0, Grootste + 1, Ontbreekt), "00000")
End With
End Sub
 
Status
Niet open voor verdere reacties.
                    Steun ons                    

Nieuwste berichten

Terug
Bovenaan Onderaan