Générer un code annyme en changeant la premiere lettre
#1
Débutant XLPages

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


Hors Ligne
Rapport   Haut 


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.

[Recherche avancée]


Qui consulte actuellement ce sujet ?   1 Utilisateur(s) anonymes