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

Opvolgendnummer per dag

Status
Niet open voor verdere reacties.
HWV

HWV

Terugkerende gebruiker
Lid geworden
19 feb 2009
Berichten
1.183
Beste,

Ik ben bezig met ons offerteregistratie om dit automatisch te laten nummeren.
Met onderstaande code dacht ik het opvolgend te krijgen maar krijg te tekst ONWAAR.

Code: 
Sub Offertenummer()

    ActiveSheet.Range("A2").End(xlDown).Offset(1, 0).Activate
            ActiveCell.FormulaR1C1 = ActiveCell.FormulaR1C1 = "=SUM(R[-1]C+1)"
                Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
    Application.CutCopyMode = False

End Sub

Nu ik de vraag toch stel hoe krijg ik dit opvolgend maar dan wil ik dit eigenlijk per dag laten opnummeren

0116012018 = 01 + 16-01-2018
0216012018 = 02 + 16-01-2018
0316012018 = 03 + 16-01-2018

0117012018 = 01 + 17-01-2018
0217012018 = 02 + 17-01-2018
0317012018 = 03 + 17-01-2018
0417012018 = 04 + 17-01-2018

0118012018 = 01 + 18-01-2018
0218012018 = 02 + 18-01-2018
0318012018 = 03 + 18-01-2018
0418012018 = 04 + 18-01-2018

enz. enz,

Ik hoop dat dit duidelijk is en dat er een oplossing voor te krijgen is.

HWV

Bekijk bijlage Offerte registratie.xlsm
 
Laatst bewerkt:
Je bijlage doet het niet.
Daarnaast kan je een datum converteren naar een getal om mee te rekenen.
16-01-2018 bijvoorbeeld is 43116
Getal = Clng(Date)
 
Het is gebruikelijker om een oplopend offertenummer, waarin ook de dag verdisconteerd is, zó vorm te geven:

20180116_001
20180116_002, etc.
 
bijlage hersteld

Beste,

Ik heb de bijlage opnieuw toegevoegd.
Als het standaard is om : 20180116_001 en 20180116_002, etc.
te gebruiken dan zou ik dit willen gaan gebruiken voor deze offerte registratie.
Maar krijg het niet voor elkaar, hoe zie hij dan dat het op een nieuwe dag op nieuw moet gaan nummeren vanaf 001

Groet HWV

Bekijk bijlage Offerte registratie.xlsm
 
Met in cel A3 --> 15012018_001 kan je de test doen:
Code: 
Sub Offertenummer()
 With ActiveSheet
    If Val(Left(.Range("A3").End(xlDown), 8)) = Val(Format(Date, "ddmmyyyy")) Then
     .Range("A3").End(xlDown).Offset(1, 0) = Val(Left(.Range("A3").End(xlDown), 8)) & "_" & Format(Val(Right(.Range("A3").End(xlDown), 3)) + 1, "000")
   Else
     .Range("A3").End(xlDown).Offset(1, 0) = Format(Date, "ddmmyyyy") & "_001"
    End If
 End With
End Sub
 
Zo bijv.
 

Bijlagen

  • __Offerte registratie.xlsb
    16,1 KB · Weergaven: 51
Fourmelding

Cobbe,

Dank voor het bericht.
Ik krijg de fout melding:

Fout1004 tijdens uitvoering
Door de toepassing of door object gedetineerde fout

Bekijk bijlage Offerte registratie.xlsm

SNB dank voor de bijdrage.
Is een mooie oplossing, maar ook nu weer zie ik dat ik niet alle informatie heb gegeven.

Ik open een offerte formulier (ik heb 4 verschillende) zodra hij deze opent dan moet hij in de offerte registratie een nummer maken en deze wil ik deze overzetten naar het offerte formulier.
Zo wil ik voorkomen dat er maar wat gedaan wordt en er zomaar een nummer aangegeven gaat worden. Vandaar dat ik het via VBA wilde doen
 
Zo dan?
 

Bijlagen

  • Offerte registratie (cobbe).xlsm
    21,3 KB · Weergaven: 63
De oplossing!

Dat is hem Cobbe, bedankt voor de inzet allemaal.
Ik kan weer verder bouwen!

Groet HWV :thumb:
 
De meest robuuste methode

Code: 
Sub M_snb()
  c00 = "G:\OF\"
  c01 = Dir(c00 & "*__")
   
  If c01 = "" Then
    CreateObject("scripting.filesystemobject").createtextfile(c00 & "0001__").write ""
  Else
    Name c00 & c01 As c00 & Format(Val(c01) + 1, "0000__")
  End If

  MsgBox Format(Val(c01), "0000")
End Sub
 
Aanvullende vraag

We werken nu al weer een tijdje hiermee en voldoet maar wil graag een aanpassing die ik niet voor elkaar krijg:

Ik gebruik nu onderstaande.

Code: 
Sub offertenummer()
With Workbooks("Offerte registratie.xlsm").Sheets("Blad1")
    If Val(Left(.Range("A3").End(xlDown), 8)) = Val(Format(Date, "ddmmyyyy")) Then
     .Range("A3").End(xlDown).Offset(1, 0) = Val(Left(.Range("A3").End(xlDown), 8)) & "_" & Format(Val(Right(.Range("A3").End(xlDown), 3)) + 1, "000")
   Else
     .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row).Offset(1, 0) = Format(Date, "ddmmyyyy") & "_001"
    End If
 End With

End Sub

Enkel de eerste zet hij goed neer maar daarna gaat het verkeerd. 1e 09022018_001 maar de tweede is als volgt 9022018_002 dus zonder de 0
Ik dacht het op te lossen met het volgende maar dat is niet zo.
hoe kan ik het wel oplossen dat als de datum 9 februari is dat dit wel als 09 getoond wordt in de registratie

Code: 
Sub offertenummer()
With Workbooks("Offerte registratie.xlsm").Sheets("Blad1")
    If Val(Left(.Range("A3").End(xlDown), 8)) = Val(Format(Date, "ddmmyyyy")) Then
     .Range("A3").End(xlDown).Offset(1, 0) = "'" & Val(Left(.Range("A3").End(xlDown), 8)) & "_" & Format(Val(Right(.Range("A3").End(xlDown), 3)) + 1, "000")
   Else
     .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row).Offset(1, 0) = "'" & Format(Date, "ddmmyyyy") & "_001"
    End If
 End With

End Sub

Groet HWV

Bekijk bijlage Offerte registratie.xlsm
 
Hoi.
Ik heb in cel a4 en a5 de vandaag() ingevuld en beiden hebben de voorloop-nul.
Het " ' " teken in je code heb ik als test weggehaald en hij doet het nog steeds.
Ik zal wel er te simpel over denken en jouw problematiek niet goed begrijpen.
 

Bijlagen

  • Test voor Forum_pv.xlsm
    13,5 KB · Weergaven: 35
Laatst bewerkt:
Telt niet meer op

Bedank voor je reactie Peenvogel,

Maar op deze manier telt hij niet meer op _001, _002 enz als er meerdere offertes zijn op een dag als je de macro laat lopen

HWV
 
Ok, hoe moet ik dat testen dan? Wat moet ik in het voorbeeldexcel invullen om te zien waar het fout gaat?
Ik zie nu 2 ingevulde cellen die door de code bewerkt zijn? Wat heb je eerst ingevuld om aan die uitkomsten te komen?
 
Beste,

Zie het VBA script wat in de module hangt. (alt +F11)
Zodra je die start dan moet hij optellen en dat doet hij nu niet meer

HWV
 
aanpassing gedan is ook de oplossing

Beste,

Ik heb de datum omgedraaid dus eerst jaar dan maand en dan dag, dit is ook goed en dan heb ik het probleem niet dat de 0 wegvalt in excel.

Code: 
Sub offertenummer()
With Workbooks("Offerte registratie.xlsm").Sheets("Blad1")
    If Val(Left(.Range("A3").End(xlDown), 8)) = Val(Format(Date, "yyyymmdd")) Then
     .Range("A3").End(xlDown).Offset(1, 0) = "" & Val(Left(.Range("A3").End(xlDown), 8)) & "_" & Format(Val(Right(.Range("A3").End(xlDown), 3)) + 1, "000")
   Else
     .Range("A" & .Range("A" & Rows.Count).End(xlUp).Row).Offset(1, 0) = "" & Format(Date, "yyyymmdd") & "_001"
    End If
 End With

End Sub

Dank voor de inzet

HWV
 
De volgorde yyyymmdd is ook de ISO standaard.
Het voordeel is ook dat je daarmee kunt sorteren.
 
werkmap delen ja of nee

Beste,

We werken nu alweer een aantal weken met dit script wat goed werkt.
Maar....
Enkel wordt het gebruikt door een 5 tal offerte formulieren die de registratie automatisch opent een offerte nummer geeft en weer sluit.
Ook dit gaat goed, maar het wil ook eens voorkomen dat meerdere mensen een offerte tegelijk aan het invullen zijn.
Dus als de registratie dan open is, zal hij de andere offerte niet opslaan!

Ik heb al gelezen dat het delen van een werkmap niet de beste oplossing is maar hoe zou ik dit anders kunnen oplossen.

HWV
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan