Generare codice univoco
draleo
7 caratteri , composto da qualsiasi carattere alfanumerico presente sulla
tastiera e anche da quelli strani che non sono visibili sulla tastiera (non
so come si chiamino).
Se non erro il num di combinazioni possibili dovrebbe essere 7 elevato a 256
Occorre però che ogni volta venga generato un codice diverso (non generato
precedentemente).
Non importa il criterio di come vengano generati; l’importante è che:
1) siano di 7 caratteri
2) non si ripetano mai, tenendo presente che quelli precedenti ogni volta
vengono cancellati e quindi non possono essere usati per controllo
Avevo pensato al num seriale corrispondente a dataoraminutisecondi (che ad
ogni secondo che passa si incrementa di una unità e quindi non è mai uguale)
ma purtroppo è di 12 carattere
Chiedo agli esperti un aiuto (credo che occorra un codice VBA )
Grazie mille
draleo
eliano
"draleo" ha scritto:
Ciao draleo.
Sinceramente non ho capito e qualcuno dirà che non è cosa nuova; comunque
prova questa soluzione un po' artigianale e molto barbara che mi porterebbe a
dire con cadenza napoletana:" Qui lo dico e qui lo nego." :-))
A B C D
31/3/08 4.20 39538,18097 55173 0153605
In A1 =ADESSO()
In B1 =ADESSO()
In C1 =INT(B1)+INT((B1-INT(B1))*24*60*60)
In D1 =DECIMALE.OCT(C1;7)
Te l'ho lasciata in chiaro e se ti è utile usala "as is", trasformala in
UDF, in una sub da usare con evento change, etc, etc; in altre parole fanne
quello che vuoi visto che la disconosco anticipando le critiche del fratello
Mauro che saluto.:-)
Eliano
Bruno Campanini
news:08D178DD-4820-4CFC...@microsoft.com...
> Ho la necessità di generare ripetutamente in una cella di Excel un codice
> di
> 7 caratteri , composto da qualsiasi carattere alfanumerico presente sulla
> tastiera e anche da quelli strani che non sono visibili sulla tastiera
> (non
> so come si chiamino).
> Se non erro il num di combinazioni possibili dovrebbe essere 7 elevato a
> 256
Erri: sono 256^7
> Occorre però che ogni volta venga generato un codice diverso (non generato
> precedentemente).
> Non importa il criterio di come vengano generati; l'importante è che:
> 1) siano di 7 caratteri
> 2) non si ripetano mai, tenendo presente che quelli precedenti ogni volta
> vengono cancellati e quindi non possono essere usati per controllo
Nessun algoritmo ti può garantire la non ripetibilità.
Occorre tener traccia delle precedenti determinazioni
se si vogliono evitare ripetizioni prima del "tempo"; il quale
"tempo" - per 256^7 - è dato da 72 057 594 037 927 936
estrazioni.
> Avevo pensato al num seriale corrispondente a dataoraminutisecondi (che ad
> ogni secondo che passa si incrementa di una unità e quindi non è mai
> uguale)
> ma purtroppo è di 12 carattere
Questa non ha senso.
Se anche fosse di 7 caratteri dopo 72 057... volte le ripetizioni
sarebbero inevitabili.
Penso dovrai accontentarti di soluzioni come quella fornita da Eliano.
Bruno
draleo
> Nessun algoritmo ti può garantire la non ripetibilità.
> Occorre tener traccia delle precedenti determinazioni
> se si vogliono evitare ripetizioni prima del "tempo"; il quale
> "tempo" - per 256^7 - è dato da 72 057 594 037 927 936
> estrazioni.
>
Grazie
Il metodo di Eliano potrebbe andare bene, ma è composto da soli caratteri
numerici. Io avrei necessità di generare codici del tipo
1=0©Z^V
6¶:|M@&
ecc
cioè sette caratteri, ognuno dei quali viene estratto a random tra i 256
caratteri ASCII (sbaglio il nome ??).
Potrei rinunciare alla univocità, perché tra le 256 ^7 combinazioni
possibili, la possibilità che vengano generati 2 codici uguali è scarsa
(anche se possibile)
Quindi mi occorrerebbe una altra soluzione soluzione in tal senso in codice
VBA (io purtroppo non ne sono in grado)
grazie
draleo
Maurizio Borrelli
news:5F6CBE7B-AFA8-435E...@microsoft.com:
[...]
> Il metodo di Eliano potrebbe andare bene, ma è composto da soli caratteri
> numerici. Io avrei necessità di generare codici del tipo
> 1=0©Z^V
> 6¶:|M@&
> ecc
> cioè sette caratteri, ognuno dei quali viene estratto a random tra i 256
> caratteri ASCII (sbaglio il nome ??).
> Potrei rinunciare alla univocità, perché tra le 256 ^7 combinazioni
> possibili, la possibilità che vengano generati 2 codici uguali è scarsa
> (anche se possibile)
> Quindi mi occorrerebbe una altra soluzione soluzione in tal senso in codice
> VBA (io purtroppo non ne sono in grado)
Ciao draleo.
Visto che ti accontenti...
Public Function GetRndString(ByVal Length) As String
Dim a() As Byte
Dim i As Long
ReDim a(1 To Length)
Randomize
For i = 1 To Length
a(i) = Int(255 * Rnd)
Next
GetRndString = StrConv(a, vbUnicode)
End Function
Da usare per esempio cosi':
[A1] = GetRndString(7)
in un Foglio di lavoro. Se la vuoi "Volatile" aggiungi come prima
istruzione eseguibile, in una riga subito prima di Redim:
Application.Volatile True
I caratteri sono si' 256, numerati da 0 a 255, ma io eviterei il
carattere zero.
(Facci sapere se e eventualmente come hai risolto. Grazie!)
--
Maurizio Borrelli [Microsoft MVP - Excel]
http://www.riolab.org/
Bruno Campanini
> Grazie
> Il metodo di Eliano potrebbe andare bene, ma è composto da soli caratteri
> numerici. Io avrei necessità di generare codici del tipo
> 1=0©Z^V
> 6¶:|M@&
> ecc
> cioè sette caratteri, ognuno dei quali viene estratto a random tra i 256
> caratteri ASCII (sbaglio il nome ??).
> Potrei rinunciare alla univocità, perché tra le 256 ^7 combinazioni
> possibili, la possibilità che vengano generati 2 codici uguali è scarsa
> (anche se possibile)
> Quindi mi occorrerebbe una altra soluzione soluzione in tal senso in
> codice
> VBA (io purtroppo non ne sono in grado)
> grazie
> draleo
Caratterì ASCII da 0 a 255:
Sub Button1_Click()
Dim S As String, i As Integer
For i = 1 To 7
S = S & Chr(Int(256 * Rnd))
Next
MsgBox S
End Sub
Bruno
draleo
> > Potrei rinunciare alla univocità...
"Maurizio Borrelli" ha scritto:
> Ciao draleo.
> Visto che ti accontenti...
grazie mille a tutti e tre. tutte le tre soluzioni funzionano benissimo
in base alle ciorcostanze vedrò quale delle tre adottare
La decisione di accontentarmi e rinunciare alla univocità del codice
generato è dovuta al fatto che mi avete fatto capire che non si può fare
altrimenti.
Ma se esistesse un'altra soluzione , che può generare dei codici senza
ripetizioni,
sarebbe ancora meglio
draleo
Bruno Campanini
[...]
> Ma se esistesse un'altra soluzione , che può generare dei codici senza
> ripetizioni,
> sarebbe ancora meglio
> draleo
Ma non hai proprio capito niente...
Se vuoi 7 caratteri scelti da 256, dopo averne ottenuto
256^7 disposizioni tutte diverse avrai per forza delle ripetizioni.
Perché le disposizioni con ripetizione di 256 elementi
presi 7 a 7 sono 256^7, non una di più.
Non solo, non ti è nemmeno garantita la possibilità di averne
256^7 senza ripetizioni posto che 72 057 594 037 927 936
stringhe da 7 caratteri allo stato dell'arte non stanno proprio
da nessuna parte.
Tutto quello che puoi fare è garantirti la non duplicazione
ogni milione ovvero ogni miliardo ovvero... di stringhe,
dipendendo ciò dalla capacità della tua RAM o del tuo HD.
Bruno
sve...@infinito.it
sven
Bruno Campanini
news:5437f777-bf94-4258...@k13g2000hse.googlegroups.com...un po' pių di educazione no eh?
sven
================================
Similia cum similibus?
Bruno
r
"draleo" ha scritto:
tutto quello qui sotto in un modulo:
'da qui ----------------
Dim Arr() As Byte
Dim arrP(0 To 7) As Double
Function IdAsc(id As String) As Double
Dim Fb() As Byte
Dim i As Long
Dim tot As Double
Dim temp As Byte
If Len(id) <> 7 Then Exit Function
id = StrReverse(id)
Call CaricaArrAsc
Call carica_arrP
Fb() = id
For i = 0 To UBound(Fb) Step 2
temp = ArrAscV(Fb(i))
tot = tot + (CDbl(temp) * arrP(i / 2))
Next
IdAsc = tot
End Function
Function ArrAscV(i As Byte) As Byte
Dim v As Byte
For v = 0 To UBound(Arr)
If Arr(v) = i Then
ArrAscV = v
End If
Next
End Function
Sub CaricaArrAsc()
Dim i As Long
Dim a As Byte
ReDim Arr(255)
For i = 48 To 57
Arr(a) = CByte(i)
a = a + 1
Next
For i = 65 To 90
Arr(a) = CByte(i)
a = a + 1
Next
For i = 97 To 122
Arr(a) = CByte(i)
a = a + 1
Next
'Debug.Print a - 1
ReDim Preserve Arr(a - 1)
End Sub
Sub carica_arrP()
Dim i As Long
For i = 0 To 7
arrP(i) = UBound(Arr) ^ i
Next
End Sub
Function Codice7(rng As Excel.Range) As String
Dim codice As String
Dim Fb() As Byte
Dim i As Long
Dim temp As Byte
Dim aB(1 To 7) As Variant
Dim a As Long
If Len(rng.Value) <> 7 Then
Codice7 = "0000000"
Exit Function
End If
codice = CStr(rng.Value)
If IdAsc(codice) = 0 Then
Codice7 = "0000001"
Exit Function
End If
codice = StrReverse(codice)
Fb() = codice
For i = 0 To UBound(Fb) Step 2
temp = ArrAscV(Fb(i))
a = a + 1
aB(a) = temp
Next
For i = 7 To 1 Step -1
aB(i) = aB(i) + 1
If aB(i) > UBound(Arr) Then
aB(i) = 0
Else
For a = 1 To 7
aB(a) = CStr(Chr(Arr(aB(a))))
Next
Codice7 = Join(aB, "")
Exit Function
End If
Next
End Function
Sub codiceUnivoco()
Dim cod As String
Dim rng As Excel.Range
Set rng = [a1]
cod = Codice7(rng)
rng = cod
End Sub
'a qui ---------------
ipotizzando di utilizzare come caratteri
i numeri da 0 a 9
le lettere minuscole e maiuscole
si ottengono 61 caratteri
quindi 61^7 valori string univoci
ovvero 3142742836021 valori
che vanno da "0000000" a "zzzzzzz"
ipotizziamo il tuo contatore in [a1]
... il formato cella di [a1] deve essere testo!
collegando un pulsante alla sub codiceUnivoco
ad ogni click il contatore avanzerà di uno.
volendo verificare a che punto sei
ovvero quanti codici hai già passato
puoi utilizzare la Function IdAsc(id As String)
per es in finestra immediata digitando
?IdAsc(cstr([a1]))
spero d'aver colto la tua esigenza ...
p.s.
il codice lo giro così come l'ho pensato
probabilmente è migliorabile e
forse alcune cose non erano necessarie
è che ho fatto un po' di tentativi
e adesso aspetto a vedere se ti può
essere utile.
fai sapere
ciao
r
r
dimenticavo ...
volendo utilizzare tutti i caratteri
scrivibili è sufficiente sostituire
la Sub CaricaArrAsc() con
questa ...
e come è facilmente intuibile potresti
scegliere tu quali caratteri utilizzare...
ciao
r
Sub CaricaArrAsc()
Dim i As Long
Dim a As Byte
ReDim Arr(255)
For i = 33 To 159
Arr(a) = CByte(i)
a = a + 1
Next
For i = 161 To 255
r
un ultima cosa ...
se tu volessi avere uno spettro di caratteri
e quindi di possibili combinazioni univoche
maggiori in numero delle molte già disponibili
utilizzando solo 7 caratteri potresti farlo
utilizzando la funzione chrw e quindi
usando caratteri unicode anche se diventerebbe
difficile riprodurli con digitazione da tastiera.
ciao
r
r
"draleo" ha scritto:
> Funzionerebbe benissimo (anche se ad una prima lettura non ho capito niente
> di come funziona, ma la studierò per benino).
> Purtroppo però , così com’è, per il mio caso non va ancora bene.
> Infatti al termine di ogni seduta di generazione dei codici io devo
> cancellare il contenuto della cella A1 per poi ricominciare nei gg successivi
> . In tal caso la tua procedura ricomincia dall’inizio e ripete gli stessi
> codici della prima seduta , mentre a me servono sempre codici nuovi
> Servirebbe depositare l’ultimo codice ottenuto da un'altra parte e
> ricominciare da quello successivo
ah! ... beh non necessariamente ... dipende quanti valori diversi utilizzi
... e in ogni caso bisognerebbe implementare ... con una funzione che
riconverte un numero decimale in uno *Nmale* .... però si può fare ...
in altre parole quello che fa adesso il codice è:
ne più ne meno di un contatore ... in cui la base è <> da 10 ...
c'è poi una funzione per risalire al decimale di quel codice ...
manca la funzione inversa (che a dirla tutta volevo scrivere ma
ho optato poi per una soluzione più semplice di crescita
di una unità alla volta) ...
però dicevo ... scrivendo tale funzione potresti partire da un valore
reso da data ora minuto ... poniamo (quando inizierai
la tua procedura ) adesso = 0 e all'apertura del
file questo valore viene aggiornato ... e poniamo che diventi 12345
è sufficiente far partire la numerazione da questo numero ... quindi
12346 .... 12347 .... etc ... ovviamente convertito nel tuo sistema
*Nmale* ... alla nuova apertura il valore reso dalla tua formula adesso
sarà 23456? ... la numerazione ripartirà da quel valore etc...
le combinazioni perse dipenderanno da quanto il file rimane chiuso ...
o da quanto dovrà rimanere chiuso tra una sessione e l'altra ...
si si può fare il problema è solo nelle possibili combinazioni che ti
occorrono ... da 61^7 dovresti togliere molte combinazioni con un
processo di questo tipo ... ne rimarrebbero comunque tante ... è anche
vero che quel 61 è aumentabile come già detto ...
quindi ciò da fare se la logica ti convince è implementare con una funzione
di conversione da decimale a Nmale ... fai sapere
... ovviamente far scrivere l'ultimo codice da qualche parte sarebbe
mooooolto più semplice ... e molto meno dispendioso ...
e ovviamente consigliabile ... e sarebbe anche quello che farei io :-)
> E’ fattibile ?
> Inoltre poiché sono un perfezionista che non capisce niente, ancora una
> domanda (che mi farà beccare un altro “amichevole” insulto)
> E’ possibile , dopo aver generato il primo codice in A1, generare il secondo
> in A2, , il terzo in A3 ecc fino ad un num variabile di celle della colonna
> A ?
questo mi sembra semplice ... basta capire meglio la logica
spiega anche il perchè vuoi farlo (come diceva alcuni post fa il buon
Norman :-)
ciao
r
Norman Jones
==================
[...]
spiega anche il perchè vuoi farlo (come diceva alcuni post fa il buon
Norman :-)
==================
Credo vada ripetuto e sia opportuno
promulgare il principio:: per ottenere
una rispostautile, sarebbe consigliabile
enunciare non soltanto la destinazione
voluta, ma anche il motivo per il viaggio.
---
Regards,
Norman
Microsoft Excel MVP
draleo
"r" ha scritto:
>questo mi sembra semplice ... basta capire meglio la logica
>spiega anche il perchè vuoi farlo
Rivelo l’arcano alla base del quesito
Da B1 a scendere fino ad B(n) ho una serie di valori , che devo aggiungere
ad una tabella di un data base SQL. Il data base però li accetta solo se
ognuno di essi è accompagnato da un codice univoco di 7 caratteri (chiave
secondaria del database). Quindi da A1 ad A(n) devo generare questi codici
sempre diversi
Poi come aggiungere questa coppia di valori al data base sono in grado di
farlo da solo, adoperando una query SQL lanciata da Excel
L’operazione naturalmente verrà ripetuta ogni 4-5 gg, sempre con nuovi
valori .
Sarebbe bene che le possibili combinazioni possibili fossero tantissime (256
^7 va bene), poiché essendoci già nel data base circa 300mila di questi
codici , la possibilità di generare codici già esistenti dovrebbe essere
bassina (se poi ogni 100 mila codici ne venisse generato uno già esistente
non cadrebbe il mondo, solo che il valore non verrebbe aggiunto alla cartella
clinica del paz e …in tal caso si aggiungerebbe a mano)
Per il resto va tutto bene. Se puoi… puoi adoperare le tecniche che ritieni
più opportune
grazie
draleo
r
"draleo" ha scritto:
> Per il resto va tutto bene. Se puoi… puoi adoperare le tecniche che ritieni
> più opportune
> grazie
> draleo
ecco come si potrebbe fare :
'in thisworkbook incolla
'da qui ------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim reg As Excel.Worksheet
Set reg = ThisWorkbook.Worksheets.Add
reg.Name = "registro"
reg.Cells(1, 1) = costante
reg.Visible = False
Set reg = Nothing
End Sub
Private Sub Workbook_Open()
Dim reg As Excel.Worksheet
Set reg = ThisWorkbook.Worksheets("registro")
reg.Visible = True
costante = reg.Cells(1, 1)
Application.DisplayAlerts = False
reg.Delete
Application.DisplayAlerts = True
Set reg = Nothing
End Sub
'a qui ------------------
' in un modulo
'incolla da qui ---------------
Option Explicit
Dim Arr() As Byte
Dim arrP(0 To 7) As Double
Public costante As String
Function IdAsc(id As String) As Double
Dim Fb() As Byte
Dim i As Long
Dim tot As Double
Dim temp As Byte
If Len(id) <> 7 Then Exit Function
id = StrReverse(id)
Call CaricaArrAsc
Call carica_arrP
Fb() = id
For i = 0 To UBound(Fb) Step 2
temp = ArrAscV(Fb(i))
tot = tot + (CDbl(temp) * arrP(i / 2))
Next
IdAsc = tot
End Function
Function ArrAscV(i As Byte) As Byte
Dim v As Byte
For v = 0 To UBound(Arr)
If Arr(v) = i Then
ArrAscV = v
End If
Next
End Function
Sub CaricaArrAsc()
Dim i As Long
Dim a As Byte
ReDim Arr(255)
For i = 33 To 159
Arr(a) = CByte(i)
a = a + 1
Next
For i = 161 To 255
Arr(a) = CByte(i)
a = a + 1
Next
'Debug.Print a - 1
ReDim Preserve Arr(a - 1)
End Sub
Sub carica_arrP()
Dim i As Long
For i = 0 To 7
arrP(i) = UBound(Arr) ^ i
Next
End Sub
Function Codice7(rng As Excel.Range) As String
Dim codice As String
Dim Fb() As Byte
Dim i As Long
Dim temp As Byte
Dim aB(1 To 7) As Variant
Dim a As Long
If Len(rng.Value) <> 7 Then
Codice7 = "0000000"
Exit Function
End If
codice = CStr(rng.Value)
If IdAsc(codice) = 0 Then
Codice7 = "0000001"
Exit Function
End If
codice = StrReverse(codice)
Fb() = codice
For i = 0 To UBound(Fb) Step 2
temp = ArrAscV(Fb(i))
a = a + 1
aB(a) = temp
Next
For i = 7 To 1 Step -1
aB(i) = aB(i) + 1
If aB(i) > UBound(Arr) Then
aB(i) = 0
Else
For a = 1 To 7
aB(a) = CStr(Chr(Arr(aB(a))))
Next
Codice7 = Join(aB, "")
Exit Function
End If
Next
End Function
Sub codiceUnivoco()
Dim cod As String
Dim rng As Excel.Range
Dim maxA As Integer
Static col As Integer
maxA = 10
If col = 0 Then col = 1
If col > maxA Then col = 1
Set rng = ActiveSheet.Range(Cells(1, 1), Cells(1, maxA))
rng.ClearContents
rng.NumberFormat = "@"
Set rng = ActiveSheet.Cells(1, col)
rng = costante
cod = Codice7(rng)
rng = cod
costante = cod
col = col + 1
Set rng = Nothing
End Sub
'a qui ----------------------
poi collega un bottone a
codiceUnivoco
ciao
r
r
"Norman Jones" ha scritto:
esattamente :-)
ciao
r
r
sul fatto di scrivere in a1 ... a2 ... a3 etc...
prova come ho capito ... ed eventualmente
credo che riuscirai facilmente ad adattare.
Buona notte a tutti
r
eliano
"draleo" ha scritto:
Ciao draleo.
Io non sono un esperto ed apprezzo enormemente tutti gli sforzi compiuti
dagli amici frequentatori del NG, ai quali rivolgo un sentito ringraziamento.
Devi costruirti un codice univoco irripetibile e la mia artigianalità mi
porta a seguirti su una parte della tua richiesta basata sulla data di
elaborazione, per cui ti riformulo la mia soluzione nella speranza (non
espressa) che qualcuno di buona volontà abbia la voglia di controllarne la
non ripetibilità.
In Excel:
A (formule)
39540,0862 =ADESSO()
2 =ORA(ADESSO())
4 =MINUTO(ADESSO())
8 =SECONDO(ADESSO())
39554,0862 =SOMMA(A10:A13)
39554 =INT(A14)
in Vba (si fa per dire) :-)
Public Sub generacodicenumerico()
'basata su data,ora,minuto,secondo
Dim giorno As Date
Dim ora As Date
Dim minuto As Date
Dim secondo As Date
Dim codice As Long
Dim codex As String
giorno = Now
ora = Hour(Now)
minuto = Minute(Now)
secondo = Second(Now)
codice = Int(giorno + ora + minuto + secondo)
codex = 0 & CDbl(codice)
MsgBox codex
ActiveSheet.UsedRange.Calculate ' per prova
End Sub
Se fosse effettivamente non ripetibile (come credo) potresti inserirlo in un
Change connesso all'immissione dei dati.
Eliano
eliano
"eliano" ha scritto:
Ciao draleo.
Prima di andare a nanna rileggevo il post e mi sono accorto che ti ho
rifilato una delle varie prove fatte, ma non l'originale che secondo me
funziona.
Scusa e provvedo:
in Excel
A B C D
2/4/08 4.24 39540,18388 55427 0154203
in A1 =ADESSO()
in B1 =ADESSO()
In C1 =INT(B1)+INT((B1-INT(B1))*24*60*60)
In D1 =DECIMALE.OCT(C1;7)
In Vba (senza scomodare gli octali) :-)
Public Sub generacodicenumerico()
Dim codice As Long
Dim codex As String
codice = Int((Now) + ((Now) - Int(Now)) * 24 * 60 * 60)
codex = "00" & CDbl(codice)
MsgBox codex
ActiveSheet.UsedRange.Calculate ' per prova
End Sub
Buona Notte.
Eliano
r
"r" ha scritto:
> Private Sub Workbook_BeforeClose(Cancel As Boolean)
>
> Dim reg As Excel.Worksheet
> Set reg = ThisWorkbook.Worksheets.Add
> reg.Name = "registro"
> reg.Cells(1, 1) = costante
> reg.Visible = False
> Set reg = Nothing
>
> End Sub
è meglio sostituirla con :
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim reg As Excel.Worksheet
On Error Resume Next
Set reg = ThisWorkbook.Worksheets("registro")
If Err Then
Err.Clear
Set reg = ThisWorkbook.Worksheets.Add
reg.Name = "registro"
End If
reg.Cells(1, 1) = costante
reg.Visible = False
Set reg = Nothing
End Sub
poi tieni presente che il file non può
essere di sola lettura e che alla fine della
sessione bisognerebbe sempre salvare
il salvataggio potresti farlo sare nell'evento
BeforeClose.
ciao
r
draleo
nella colonna A anziché nella riga 1 ( senza disturbarti !)
Grazie
draleo
"r" ha scritto: