Remplacer les données d'une plage selon un tableau de correspondances définies

Page mise à jour le : 18/10/2009

      Question posée (Sur le forum XLDowloads)

Je souhaiterais votre aide pour l'écriture d'une macro afin de
renommer, dans un planning, des codes selon un tableau de
correspondances définies...
     
      Le problème posé en image
      Méthode proposée

Nous allons travailler avec des variables tableaux ce qui permet avec
des plages importantes d'avoir un temps de traitement très optimisé car
c'est beaucoup plus rapide qu'une boucle du type par exemple For Each Cell Selection.
     
     Le programme se décompose en 4 étapes
     1 - Mise en mémoire de la plage de données contenant les codes de correspondance.
     2 - Mise en mémoire de la plage de données contenant les codes à changer
     3 - Lecture en mémoire de cette plage avec le remplacement (en mémoire) par l'équivalent code
     4 - Ecriture dans la plage de données du classeur des nouveaux codes en lieu et place des précédents.
     
     Le classeur à télécharger
     
      Le code VBA du programme
     

Sub ConversionCodes()

   Application.ScreenUpdating = False

   ' Déclaration des variables

   Dim PlgCodes As Variant

   Dim TableauCodes() As Variant

   Dim PlgAConvertir As Variant

   Dim I As Integer : Dim J As Integer : Dim K As Integer

   Dim Plg As Range

   Dim NRow As Integer : Dim NCol As Integer

   ' ****** Début du traitement *****

   Sheets( "Codes" ).Activate

   ' Récupération de la plge de codes équivalents dans le tableau PlgCodes

   PlgCodes = Range( "A3:B59" ).Value

   For I = 1 To UBound (PlgCodes)

      ReDim Preserve TableauCodes( 1 To UBound (PlgCodes), 2 )

      TableauCodes(I, 1 ) = PlgCodes(I, 1 )

      TableauCodes(I, 2 ) = PlgCodes(I, 2 )

   Next I

   Sheets( "Planning" ).Activate

   [B6].Select

   With Selection.CurrentRegion

      Intersect(.Cells, .Offset( 1 , 1 )).Select

   End With

   ' Attribue une référence d'objet à Plg représentant la sélection en cours

   Set Plg = Selection

   ' Récupération de la plage de données à convertir dans le tableau PlgAConvertir

   PlgAConvertir = Selection.Value

   ' Trouver les dimensions du tableau PlgAConvertir

   NRow = Selection.Rows.Count

   NCol = Selection.Columns.Count

   ' Lecture et remplacement des données en cours par leur code équivalent

   For J = 1 To NRow

      For I = 1 To NCol

         ReDim Preserve PlgAConvertir( 1 To NRow, 1 To NCol)

         For K = 1 To UBound (PlgCodes)

            If PlgAConvertir(J, I) = PlgCodes(K, 1 ) Then PlgAConvertir(J, I) = PlgCodes(K, 2 ): Exit For

         Next K

      Next I

   Next J

   Sheets( "Planning" ).Activate

   ' Remplacer les données actuelles par leurs nouveux codes

   Plg.Value = PlgAConvertir

   [A1].Select

End Sub