Forums XLPages

Tous les messages (Rickly)

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