Générer un code annyme en changeant la premiere lettre

Rickly · 28/12/2011, 17h54

bonjour je joint mon code vba en dessous et je vous explique ce que j'aimerai faire, j'aimerai créer des numero anonyme exemple pour le numero : H112 une correspondance dans une autre page qui se rai un autre code mais j'aimerai pouvoir changer la lettre par une autre lettre voici le code .....

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
<ol style="list-style-type: decimal"><li>Sub GenererIdAnonyme()</li>
<li>''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''</li>
<li>' '</li>
<li>' GénérerIdAnonyme Macro '</li>
<li>' Ce macro fait une correspondance entre les numéros des candidats et les numéros anonymes générés.'</li>
<li>' '</li>
<li>''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''</li>
<li>Dim typeConcours As String</li>
<li>typeConcours = DA 'DA= Directe A</li>
<li>Dim feuil_dest As String</li>
<li>feuil_dest = "Correspondance"</li>
<li>Dim pointeur_feuil_dest As Integer</li>
<li>pointeur_feuil_dest = 1</li>
<li>Dim feuil_debut As String</li>
<li>feuil_debut = "PRE SELECTION"</li>
<li>Dim pointeur_feuil_debut As Integer</li>
<li>pointeur_feuil_debut = 1
</li>
<li>Dim nbTotalCandidats As Integer</li>
<li>Dim nbTotalCand1 As Integer</li>
<li>Dim nbTotalCand2 As Integer</li>
<li>Dim nbTotalCand3 As Integer</li>
<li>nbTotalCand1 = 500</li>
<li>nbTotalCand2 = 1000</li>
<li>nbTotalCand3 = 1500</li>
<li>nbTotalCandidats = 1500
</li>
<li>Dim order As Integer
</li>
<li>With Sheets(feuil_debut)</li>
<li>cpt_PFD = pointeur_feuil_debut</li>
<li>order = pointeur_feuil_dest</li>
<li>For Each cell In .Range("A:A").Cells</li>
<li>If Not cell.value = "" Then</li>
<li>.Range("A" & cpt_PFD).Copy Destination:=Sheets(feuil_dest).Range("A" & order)</li>
<li>If order <= nbTotalCand1 Then</li>
<li>Sheets(feuil_dest).Range("B" & cpt_PFD).value = getIdAnonyme(cell.value, 1)</li>
<li>Else</li>
<li>If order <= nbTotalCand2 Then</li>
<li>Sheets(feuil_dest).Range("B" & cpt_PFD).value = getIdAnonyme(cell.value, 2)</li>
<li>Else</li>
<li>If order <= nbTotalCand3 Then</li>
<li>Sheets(feuil_dest).Range("B" & cpt_PFD).value = getIdAnonyme(cell.value, 3)</li>
<li>End If</li>
<li>End If</li>
<li>End If</li>
<li>.Range("B" & cpt_PFD).Copy Destination:=Sheets(feuil_dest).Range("C" & order)</li>
<li>.Range("C" & cpt_PFD).Copy Destination:=Sheets(feuil_dest).Range("D" & order)</li>
<li>.Range("D" & cpt_PFD).Copy Destination:=Sheets(feuil_dest).Range("E" & order)</li>
<li>.Range("E" & cpt_PFD).Copy Destination:=Sheets(feuil_dest).Range("F" & order)</li>
<li>.Range("F" & cpt_PFD).Copy Destination:=Sheets(feuil_dest).Range("G" & order)</li>
<li>order = order + 1</li>
<li>End If</li>
<li>If cpt_PFD <= (nbTotalCandidats + pointeur_feuil_debut + 1) Then</li>
<li>cpt_PFD = cpt_PFD + 1</li>
<li>Else</li>
<li>Exit Sub</li>
<li>End If</li>
<li>Next cell</li>
<li>End With</li>
<li>End Sub
</li>
<li>Function getIdAnonyme(id As String, ind As Integer)</li>
<li>' Algo: On considére un tableau de 10 elements fixés. Les indices du tabeau varient alors de 0 à 9</li>
<li>' ce qui constituent les différents combinaisons de chiffres possible pour identifier un candidat.</li>
<li>' Le candidat de numéro 309 aura comme IdAnonyme la concaténation des elements du tableau aux positions</li>
<li>' respectives 3, 0 et 9 ie idAnonymyme=tab(3)+tab(0)+tab(9) LAs
</li>
<li>Dim elmt1() As Variant</li>
<li>Dim elmt2() As Variant</li>
<li>Dim elmt3() As Variant</li>
<li>elmt1 = Array("YB13", "Tnt", "Lj", "Ghft", "Cn", "Tv", "2i", "Zm", "y", "s")</li>
<li>elmt2 = Array("Ru", "Z", "2a", "Vp", "N", "Kh", "Zi", "Pi", "Ev", "F2")</li>
<li>elmt3 = Array("Do", "Bo", "0k", "3r", "5", "Ph", "Br", "li", "5", "2")</li>
<li>Dim idGenerated As String</li>
<li>idGenerated = Mid(id, 1, 1)</li>
<li>For cp = 2 To (Len(id)) ' A revoir source d'erreur : la fin de boucle</li>
<li>If Not Mid(id, cp, 1) = "." Then</li>
<li>If ind = 1 Then</li>
<li>idGenerated = idGenerated + elmt1(Val(Mid(id, cp, 1)))</li>
<li>End If</li>
<li>If ind = 2 Then</li>
<li>idGenerated = idGenerated + elmt2(Val(Mid(id, cp, 1)))</li>
<li>End If</li>
<li>If ind = 3 Then</li>
<li>idGenerated = idGenerated + elmt3(Val(Mid(id, cp, 1)))</li>
<li>End If</li>
<li>End If</li>
<li>Next</li>
<li>getIdAnonyme = idGenerated</li>
<li>End Function</li>
</ol>

Qwazerty · 29/12/2011, 14h19

Salut

Qu'est ce qui ne fonctionne pas avec ton code?

Plutôt que de généré des numéro pseudo codé, pourquoi ne pas utiliser un algorithme non destructif déjà existant, il en existe plusieurs qui permettent de codé décoder?

En attendant plus de précision, j'ai remis un peu d'ordre dans le code et modifié la partie génération de clé. Je n'ai pas testé, regarde ce que ça donne.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
Option Explicit
 
Sub GenererIdAnonyme()
 
End Sub
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' '
' GénérerIdAnonyme Macro '
' Ce macro fait une correspondance entre les numéros des candidats et les numéros anonymes générés.'
' '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim TypeConcours As String
Dim Feuil_Dest As String
Dim Pointeur_Feuil_Dest As Integer
Dim Feuil_debut As String
Dim Pointeur_Feuil_Debut As Integer
Dim nbTotalCandidats As Integer
Dim nbTotalCand1 As Integer
Dim nbTotalCand2 As Integer
Dim nbTotalCand3 As Integer
Dim Order As Integer
 
TypeConcours = DA 'DA= Directe A
Feuil_Dest = "Correspondance"
Pointeur_Feuil_Dest = 1
Feuil_debut = "PRE SELECTION"
Pointeur_Feuil_Debut = 1
 
nbTotalCand1 = 500
nbTotalCand2 = 1000
nbTotalCand3 = 1500
nbTotalCandidats = 1500
 
 
With Sheets(Feuil_debut)
    cpt_pfd = Pointeur_Feuil_Debut
    Order = Pointeur_Feuil_Dest
    For Each cell In .Range("A:A").Cells
        If Not cell.Value = "" Then
            .Range("A" & cpt_pfd).Copy Destination:=Sheets(Feuil_Dest).Range("A" & Order)
            If Order <= nbTotalCand1 Then
                Sheets(Feuil_Dest).Range("B" & cpt_pfd).Value = getIdAnonyme(cell.Value, 1)
            Else
                If Order <= nbTotalCand2 Then
                    Sheets(Feuil_Dest).Range("B" & cpt_pfd).Value = getIdAnonyme(cell.Value, 2)
                Else
                    If Order <= nbTotalCand3 Then
                        Sheets(Feuil_Dest).Range("B" & cpt_pfd).Value = getIdAnonyme(cell.Value, 3)
                    End If
                End If
            End If
            'Essai comme ça
 
            .Cells(cpt_pfd, "B").Resize(0, 5).Copy Sheets(Feuil_Dest).Cells(Order, "C").Resize(0, 5)
            '.Range("B" & cpt_pfd).Copy Destination:=Sheets(Feuil_Dest).Range("C" & Order)
            '.Range("C" & cpt_pfd).Copy Destination:=Sheets(Feuil_Dest).Range("D" & Order)
            '.Range("D" & cpt_pfd).Copy Destination:=Sheets(Feuil_Dest).Range("E" & Order)
            '.Range("E" & cpt_pfd).Copy Destination:=Sheets(Feuil_Dest).Range("F" & Order)
            '.Range("F" & cpt_pfd).Copy Destination:=Sheets(Feuil_Dest).Range("G" & Order)
            Order = Order + 1
        End If
        If cpt_pfd <= (nbTotalCandidats + Pointeur_Feuil_Debut + 1) Then
            cpt_pfd = cpt_pfd + 1
        Else
            Exit Sub
        End If
    Next cell
End With
End Sub
 
Function getIdAnonyme(id As String, ind As Integer) As String
' Algo: On considére un tableau de 10 elements fixés. Les indices du tabeau varient alors de 0 à 9
' ce qui constituent les différents combinaisons de chiffres possible pour identifier un candidat.
' Le candidat de numéro 309 aura comme IdAnonyme la concaténation des elements du tableau aux positions
' respectives 3, 0 et 9 ie idAnonymyme=tab(3)+tab(0)+tab(9) LAs
 
Dim elmt(2) As Variant
 
elmt(0) = Array("YB13", "Tnt", "Lj", "Ghft", "Cn", "Tv", "2i", "Zm", "y", "s")
elmt(1) = Array("Ru", "Z", "2a", "Vp", "N", "Kh", "Zi", "Pi", "Ev", "F2")
elmt(2) = Array("Do", "Bo", "0k", "3r", "5", "Ph", "Br", "li", "5", "2")
 
getIdAnonyme = Mid(id, 1, 1)
 
For cp = 2 To Len(id) ' A revoir source d'erreur : la fin de boucle
    'Poue la concaténation on utilise &
    If Not Mid(id, cp, 1) = "." Then getIdAnonyme = getIdAnonyme & elmt(ind - 1)(CInt(Mid(id, cp, 1)))
Next
End Function

++Qwaz

Outils de la discussion
Afficher une version imprimable Envoyer un lien vers cette page par email