,Sub Generation()
Application.ScreenUpdating = 0
Range("A2:A65000").ClearContents
For i = 1 To [F2]
ActiveSheet.Range("A65000").End(xlUp).Offset(1, 0).Value = [D2] & x & Format(i, "00000") & [E2]
Next
Application.ScreenUpdating = 1
End SubBonjour à tous,
Saut Hasco
Un code qui génère des... codes (renseigner D2:F2)
Code:Sub Generation() Application.ScreenUpdating = 0 Range("A2:A65000").ClearContents For i = 1 To [F2] ActiveSheet.Range("A65000").End(xlUp).Offset(1, 0).Value = [D2] & x & Format(i, "00000") & [E2] Next Application.ScreenUpdating = 1 End Sub
A++
A+ à tous
Bonjour à tous,
Saut Hasco
Un code qui génère des... codes (renseigner D2:F2)
Code:Sub Generation() Application.ScreenUpdating = 0 Range("A2:A65000").ClearContents For i = 1 To [F2] ActiveSheet.Range("A65000").End(xlUp).Offset(1, 0).Value = [D2] & x & Format(i, "00000") & [E2] Next Application.ScreenUpdating = 1 End Sub
A++
A+ à tous
,
Bonjour,
Hello JC
Toujours pas compris m'enfin voici un classeur avec une méthode possible.
Entrer un nom de produit en colonne B de la feuil1 et une référence basée sur une forme HexaDecimale de la date + heure+minute+seconde est générée.
Limite: risque de doublons si plus d'un produit est ajouté par seconde(par macro par exemple).
A+
Sub A_COD(ByVal c As Long, Optional p As String)
' 21 Nivôse CCXVII
' ROGER2327 fecit.
Dim i As Long, j As Long, n As String, cal As Long, tf As Boolean
Dim dat()
Dim pt()
Application.ScreenUpdating = False
cal = Application.Calculation
Application.Calculation = xlCalculationManual
[COLOR="DarkOliveGreen"]' Interprétation du descripteur p[/COLOR]
If Len(p) = 0 Then ' modèle par défaut
pt = Array(8, Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), Array(0, "-"), _
Array(10, "1234567890"), Array(10, "1234567890"), Array(0, "-"), Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"), _
Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
Else
ReDim pt(Len(p))
pt(0) = 0
j = 1
For i = 1 To Len(p)
n = Mid$(p, j, 1)
Select Case n
Case ""
Case "["
n = Mid$(p, j + 1, InStr(j, p, "]") - j - 1)
pt(i) = Array(0, n)
j = j + Len(n) + 2
pt(0) = 1 + pt(0)
Case Else
Select Case n
Case "0": pt(i) = Array(10, "1234567890"): pt(0) = 1 + pt(0): j = j + 1
Case "9": pt(i) = Array(9, "123456789"): pt(0) = 1 + pt(0): j = j + 1
Case "L": pt(i) = Array(26, "ABCDEFGHIJKLMNOPQRSTUVWXYZ"): pt(0) = 1 + pt(0): j = j + 1
Case "M": pt(i) = Array(24, "ABCDEFGHJKLMNPQRSTUVWXYZ"): pt(0) = 1 + pt(0): j = j + 1
Case "C": pt(i) = Array(20, "BCDFGHJKLMNPQRSTVWXZ"): pt(0) = 1 + pt(0): j = j + 1
Case "V": pt(i) = Array(6, "AEIOUY"): pt(0) = 1 + pt(0): j = j + 1
Case "W": pt(i) = Array(4, "AEUY"): pt(0) = 1 + pt(0): j = j + 1
Case Else: pt(i) = Array(0, Mid$(p, j, 1)): pt(0) = 1 + pt(0): j = j + 1
End Select
End Select
Next i
End If
ReDim Preserve pt(pt(0))
[COLOR="DarkOliveGreen"]' Fin de l'interprétation du descripteur p[/COLOR]
[COLOR="DarkOliveGreen"]' Engendrement des références[/COLOR]
dat = Cells(1, c).CurrentRegion.Value
For i = 2 To UBound(dat, 1)
If IsEmpty(dat(i, c)) Then
Do
n = ""
tf = False
For j = 1 To pt(0)
If pt(j)(0) Then
n = n & Mid$(pt(j)(1), Int(pt(j)(0) * Rnd() + 1), 1)
Else
n = n & pt(j)(1)
End If
Next j
For j = 2 To UBound(dat, 1): tf = tf Or (n = dat(j, c)): Next j
Loop While tf
dat(i, c) = n
Cells(i, c) = n
End If
Next i
[COLOR="DarkOliveGreen"]' Fin de l'engendrement des références[/COLOR]
Application.Calculation = cal
Application.ScreenUpdating = True
End SubA_COD [I]numéro_de_colonne[/I], [I]descripteur_de_référence[/I]Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Cells(1, 1).Address = "$A$1" Then A_COD 1, Target.Cells(1, 1).Value: Cancel = True
End Sub
