Générer un code annyme en changeant la premiere lettre |
Titre du sujet : Générer un code annyme en changeant la premiere lettre par Rickly le 28/12/2011 20:06:08 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 |
Forums