Option Explicit
[COLOR="SeaGreen"]'A placer dans un module standard[/COLOR]
Sub A_COD(ByVal c As Long, Optional p As String)
[COLOR="SeaGreen"]' 21 Nivôse CCXVII[/COLOR]
[COLOR="SeaGreen"]' ROGER2327 fecit.[/COLOR]
Dim i As Long, j As Long, n As String, cal As Long
Dim dat(), UBDat As Long
Dim pt()
Application.ScreenUpdating = False
cal = Application.Calculation
Application.Calculation = xlCalculationManual
If Len(p) = 0 Then [COLOR="SeaGreen"]' modèle par défaut LL[-]00[-]LL[/COLOR]
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
i = 1
For i = 1 To Len(p)
n = Mid$(p, j, 1)
Select Case n
Case "": Exit For
Case "{"
n = Mid$(p, j + 1, InStr(j, p, "}") - j - 1)
If IsNumeric(n) Then pt(i) = Array(-1, CInt(n)) Else pt(i) = Array(-1, Range(n & "1").Column)
j = j + Len(n) + 2
pt(0) = 1 + pt(0)
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))
dat = Cells(1, c).CurrentRegion.Value
UBDat = UBound(dat, 1)
For i = 2 To UBDat
If IsEmpty(dat(i, c)) Then
Do
n = ""
For j = 1 To pt(0)
Select Case pt(j)(0)
Case -1: n = n & dat(i, pt(j)(1))
Case 0: n = n & pt(j)(1)
Case Else: n = n & Mid$(pt(j)(1), Int(pt(j)(0) * Rnd() + 1), 1)
End Select
Next j
For j = 2 To UBDat
If n = dat(j, c) Then Exit For
Next j
Loop Until j > UBDat
dat(i, c) = n
Cells(i, c) = n
End If
Next i
Application.Calculation = cal
Application.ScreenUpdating = True
End Sub