Table correspondance sur plusieurs feuilles Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Répondre
H
HUGOBASS
Membre fidèle
Membre fidèle
Messages : 200
Appréciation reçue : 1
Inscrit le : 18 septembre 2014
Version d'Excel : Mac 2016 FR

Message par HUGOBASS » 23 octobre 2018, 10:38

Bonjour à toutes et tous

En mettant en place vos conseils et solutions du post ci après j'ai pu créer une table de correspondance qui corrige certaines valeurs d'une feuille précise.
https://forum.excel-pratique.com/viewt ... 2&t=85137

Je cherche à adapter les codes ci après pour que la table soit valable non pas uniquement sur une seule feuille précise mais sur toutes les feuilles du classeur à l'exclusion de certaines (des boucles imbriquées)

code fonctionnelle sur une feuille précise :

Sub CorrespondanceCol()

    Dim d As New Collection, n%, i%
    With Worksheets("TABLE")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            d.Add .Cells(i, 2), CStr(.Cells(i, 1))
        Next i
    End With
    With Worksheets("BASE TRAITEE MACRO")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
        For i = 2 To n
            .Cells(i, 1) = d(CStr(.Cells(i, 1)))
        Next i
    End With

With Application
.ScreenUpdating = False
.DisplayAlerts = False
End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
Sub Correspondance()
    
    Dim Cold(), Cnew(), n%, i%, j%
    With Worksheets("TABLE")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        ReDim Cold(1 To n - 1): ReDim Cnew(1 To n - 1)
        For i = 2 To n
            Cold(i - 1) = .Cells(i, 1)
            Cnew(i - 1) = .Cells(i, 2)
        Next i
    End With
    With Worksheets("BASE TRAITEE MACRO")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
        For i = 2 To n
            j = WorksheetFunction.Match(.Cells(i, 1), Cold, 0)
            If Err.Number = 0 Then
                .Cells(i, 1) = Cnew(j)
            Else
                Err.Clear
            End If
        Next i
        .Activate
    End With
End Sub
En m'inspirant d'autre éléments que vous m'avez déjà proposé j'ai essayé mais sans succès d'adapter ces 2 codes sur la base ci après, pourriez vous m'aider a finaliser mon approche. Je joins un classeur exemple.

Merci
Cordialement
Hugues
Sub CorresondanceColbis()

Dim d As New Collection, n%, i%
    With Worksheets("TABLE")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            d.Add .Cells(i, 2), CStr(.Cells(i, 1))
        Next i
    End With

For Each sh In Worksheets
      Select Case sh.Name
         Case "A ECARTER 01", "A ECARTER 01", "BASE EXEMPLE avant macro", "TABLE"
         Case Else

        n = sh.Cells(.Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
        For i = 2 To n
            sh.Cells(i, 1) = d(CStr(sh.Cells(i, 1)))
        Next i
   
End Select
   Next sh

End Sub
Sub Correspondancebis()
    
    Dim Cold(), Cnew(), n%, i%, j%
    With Worksheets("TABLE")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        ReDim Cold(1 To n - 1): ReDim Cnew(1 To n - 1)
        For i = 2 To n
            Cold(i - 1) = .Cells(i, 1)
            Cnew(i - 1) = .Cells(i, 2)
        Next i
    End With
    
    For Each sh In Worksheets
      Select Case sh.Name
         Case "A ECARTER 01", "A ECARTER 01", "BASE EXEMPLE avant macro", "TABLE"
         Case Else
    
        n = sh.Cells(.Rows.Count, 1).End(xlUp).Row
        On Error Resume Next
        For i = 2 To n
            j = WorksheetFunction.Match(sh.Cells(i, 1), Cold, 0)
            If Err.Number = 0 Then
                sh.Cells(i, 1) = Cnew(j)
            Else
                Err.Clear
            End If
        Next i
        sh.Activate
    Next sh

End Sub
Table correspondance V01.xlsm
(24.45 Kio) Téléchargé 6 fois
Avatar du membre
Ausecour
Passionné d'Excel
Passionné d'Excel
Messages : 3'118
Appréciations reçues : 346
Inscrit le : 31 mai 2018
Version d'Excel : 2010 FR, 2013 FR

Message par Ausecour » 23 octobre 2018, 15:02

Bonjour,

J'ai tenté de corrigé des défauts de programmation en mode déboguage sur tes différents programmes :
Corresondancecolbis:Afficher
Sub CorresondanceColbis()

Dim d As New Collection, n%, i%
    With Worksheets("TABLE")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        For i = 2 To n
            d.Add .Cells(i, 2), CStr(.Cells(i, 1))
        Next i
    End With

For Each sh In Worksheets
    Select Case sh.Name
        Case "A ECARTER 01", "A ECARTER 01", "BASE EXEMPLE avant macro", "TABLE"
        Case Else

        n = sh.Cells(Rows.Count, 1).End(xlUp).Row 'référence incorrecte ou non qualifiée sur .rows
        'remplacé par Rows, tu n'as pas fait de with pour ton .rows j'utilise la feuille active
        
        On Error Resume Next
        For i = 2 To n
            sh.Cells(i, 1) = d(CStr(sh.Cells(i, 1)))
        Next i
   
    End Select
Next sh

End Sub
Correspondancebis:Afficher
Sub Correspondancebis()
    
    Dim Cold(), Cnew(), n%, i%, j%
    With Worksheets("TABLE")
        n = .Cells(.Rows.Count, 1).End(xlUp).Row
        ReDim Cold(1 To n - 1): ReDim Cnew(1 To n - 1)
        For i = 2 To n
            Cold(i - 1) = .Cells(i, 1)
            Cnew(i - 1) = .Cells(i, 2)
        Next i
    End With
    
    For Each sh In Worksheets
      Select Case sh.Name
         Case "A ECARTER 01", "A ECARTER 01", "BASE EXEMPLE avant macro", "TABLE"
         Case Else
    
            n = sh.Cells(Rows.Count, 1).End(xlUp).Row 'référence incorrecte ou non qualifiée sur .rows
            'remplacé par Rows, tu n'as pas fait de with pour ton .rows j'utilise la feuille active
            On Error Resume Next
            For i = 2 To n
                j = WorksheetFunction.Match(sh.Cells(i, 1), Cold, 0)
                If Err.Number = 0 Then
                    sh.Cells(i, 1) = Cnew(j)
                Else
                    Err.Clear
                End If
            Next i
            sh.Activate
        End Select
    Next sh 'next sans for, dû au fait que tu n'aies pas de end select, tu n'avais pas tabulé après ton end select,
    'tu ne pouvais pas voir qu'il était manquant

End Sub
Je ne rencontre plus de bug en lançant ton programme avec ces corrections, j'espère que ça suffira, je te laisse faire le reste des tests :)
Plus un sujet a un titre précis, des explications claires, et un fichier Excel bien préparé, plus il a de chances d'avoir une réponse qui répond au besoin, mettez toutes les chances de votre côté :bien:
"100% des gagnants auront tenté leur chance" :trfl:
H
HUGOBASS
Membre fidèle
Membre fidèle
Messages : 200
Appréciation reçue : 1
Inscrit le : 18 septembre 2014
Version d'Excel : Mac 2016 FR

Message par HUGOBASS » 23 octobre 2018, 17:39

Bonjour Ausecour,

Un grand merci un grand bravo
Solutions et explications à mes erreurs et très rapidement

Très cordialement

Hugues
Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message