Générer un code annyme en changeant la premiere lettre | ||
---|---|---|
Inscription: 28/12/2011
Messages:
1
Système d'exploitation: PC Version Excel utilisée: 2007 |
Posté le : 28-12-2011 20h06
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 |
|
|
Vous pouvez voir les sujets.
Vous ne pouvez pas débuter de nouveaux sujets.
Vous ne pouvez pas répondre aux contributions.
Vous ne pouvez pas éditer vos contributions.
Vous ne pouvez pas effacez vos contributions.
Vous ne pouvez pas ajouter de nouveaux sondages.
Vous ne pouvez pas voter en sondage.
Vous ne pouvez pas attacher des fichiers à vos contributions.
Vous ne pouvez pas poster sans approbation.
Qui consulte actuellement ce sujet ?
1 Utilisateur(s) anonymes