Table correspondance sur plusieurs feuilles
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/viewtopic.php?f=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
Bonjour,
J'ai tenté de corrigé des défauts de programmation en mode déboguage sur tes différents programmes :
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
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
Bonjour Ausecour,
Un grand merci un grand bravo
Solutions et explications à mes erreurs et très rapidement
Très cordialement
Hugues