correction de mon code vba

[Guest]

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



Sub GenererIdAnonyme()
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' '
' 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
typeConcours = DA 'DA= Directe A

Dim feuil_dest As String
feuil_dest = "Correspondance"
Dim pointeur_feuil_dest As Integer
pointeur_feuil_dest = 1

Dim feuil_debut As String
feuil_debut = "PRE SELECTION"
Dim pointeur_feuil_debut As Integer
pointeur_feuil_debut = 1


Dim nbTotalCandidats As Integer
Dim nbTotalCand1 As Integer
Dim nbTotalCand2 As Integer
Dim nbTotalCand3 As Integer

nbTotalCand1 = 500
nbTotalCand2 = 1000
nbTotalCand3 = 1500
nbTotalCandidats = 1500


Dim order As Integer


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

' 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 elmt1() As Variant
Dim elmt2() As Variant
Dim elmt3() As Variant

elmt1 = Array("YB13", "Tnt", "Lj", "Ghft", "Cn", "Tv", "2i", "Zm", "y", "s")
elmt2 = Array("Ru", "Z", "2a", "Vp", "N", "Kh", "Zi", "Pi", "Ev", "F2")
elmt3 = Array("Do", "Bo", "0k", "3r", "5", "Ph", "Br", "li", "5", "2")

Dim idGenerated As String

idGenerated = Mid(id, 1, 1)

For cp = 2 To (Len(id)) ' A revoir source d'erreur : la fin de boucle
If Not Mid(id, cp, 1) = "." Then
If ind = 1 Then
idGenerated = idGenerated + elmt1(Val(Mid(id, cp, 1)))
End If
If ind = 2 Then
idGenerated = idGenerated + elmt2(Val(Mid(id, cp, 1)))
End If
If ind = 3 Then
idGenerated = idGenerated + elmt3(Val(Mid(id, cp, 1)))
End If
End If
Next
getIdAnonyme = idGenerated

End Function

 

[zeb]

Merci de lire, accepter et respecter le règlement : l'utilisation de la balise

 est obligatoire.

----------------------------------------

Joyeuses fêtes à tous !