XL 2016 Problèmes de Range, tentative de boucle entre 2 fichiers

R3n0W

XLDnaute Nouveau
Bonjour
Après mes 3 premiers jours de codage je suis encore novice en VBA mais je me soigne :)
Je souhaite exécuter une macro me permettant, depuis un fichier maitre avec tous mes compteurs, de consulter dans un fichier de relève avec seulement quelques compteurs la correspondance entre ces 2 fichiers des numéros de compteurs et lorsqu'un compteur est identique entre les 2 fichiers, récupérer la valeur du relevé dans la colonne "RELEVE" du fichier de relève et la mettre dans la colonne "MOIS" du fichier des index (le fichier maitre)

J'ai opéré plusieurs tentatives mais toutes échouent lors de ma condition "If"

Vous constaterez dans le code toutes les différentes tentatives effectuées... Et les différents messages d'erreurs associés.
Je cale.

Petit coup de main ? 😁

Précision : lorsque je fais appel à ma variable "MOIS" cela peut correspondre à plusieurs choses nommées de la même façon dans un esprit de simplicité. A savoir :
- Les onglets du fichier de relève
- L'objet tableau dans cet onglet
- Le nom de la colonne de l'objet tableau du fichier maître

VB:
    'Workbooks.Open Filename:= _
        "S:\DSTG\STL\SAG\LOT3_EAU\2023\03_EXPLOITATION ET MAINTENANCE\6_Relevé mensuel_compteurs\TEST µ\Stock Fichiers de Relève\Relève des compteurs à Intégrer.xlsx"
    'Worksheets(MOIS).Activate
   
' Ignorer les erreurs

'On Error Resume Next

Dim MOIS As String
MOIS = MonthName(Month(Date))
MOIS1 = MonthName(Month(Date) - 1)


Dim Wbk_Index As Workbook
Set Wbk_Index = Workbooks("2023_Index Compteurs Annuel - Copie.xlsm")

Dim Ws_Index As Worksheet
Set Ws_Index = Wbk_Index.Worksheets("Relevés Compteurs")

Dim NumComptIndex As Range
Set NumComptIndex = Ws_Index.ListObjects("Index_Compteurs").ListColumns("N° COMPTEUR PHYSIQUE").Range

Dim IndexMois As Range
Set IndexMois = Ws_Index.ListObjects("Index_Compteurs").ListColumns(MOIS).Range



Dim Wbk_Releve As Workbook
Set Wbk_Releve = Workbooks("Relève des Compteurs à intégrer.xlsx")
'Set Wbk_Releve = Application.Workbooks.Open("S:\DSTG\STL\SAG\LOT3_EAU\2023\03_EXPLOITATION ET MAINTENANCE\6_Relevé mensuel_compteurs\TEST µ\Stock Fichiers de Relève\Relève des compteurs à Intégrer.xlsx")

Dim Ws_Releve As Worksheet
Set Ws_Releve = Wbk_Releve.Worksheets(MOIS)

Dim NumComptReleve As Range
'Set NumComptReleve = Ws_Releve.Cells("C2:C").SpecialCells(xlConstants)
'Set NumComptReleve = Ws_Releve.Cells(Rows.Count, 3).End(xlUp).Row
Set NumComptReleve = Ws_Releve.ListObjects(MOIS).ListColumns("N° COMPTEUR PHYSIQUE").Range

Dim IndexReleve As Range
'Set IndexReleve = Ws_Releve.Cells("E2:E").SpecialCells(xlConstants)
'Set IndexReleve = Ws_Releve.Cells(Rows.Count, 5).End(xlUp).Row
Set IndexReleve = Ws_Releve.ListObjects(MOIS).ListColumns("RELEVE").Range


For Each NumComptReleve In NumComptIndex
   
    'If NumComptReleve.Cells.Value = NumComptIndex.Cells.Value Then _

'Argument ou appel de procédure incorrecte
    'If Ws_Releve.Cells(NumComptReleve).Value = Ws_Index.Cells(NumComptIndex).Value Then _

'la méthode range de l'objet _Worksheet a échoué
    If Ws_Releve.Range(NumComptReleve).Value = Ws_Index.Range(NumComptIndex).Value Then _

'la méthode range de l'objet _global a échoué
    'If Ws_Releve.Cells(Range(NumComptReleve)).Value = Ws_Index.Cells(Range(NumComptIndex)).Value Then _



        Ws_Index.Cells(IndexMois).Value = Ws_Releve.Cells(IndexReleve).Value
       
    End If
   
    'If NumComptIndex.Cells.Value = NumComptReleve.Cells.Value Then Ws_Index.Cells(IndexMois).Value = Ws_Releve.Cells(IndexReleve).Value
   
   
Next
 
Dernière édition:
Solution
Aller, je vous donne la réponse, je suis sûr que cela pourra servir.
J'ai pas l'impression que beaucoup de personnes sachent utiliser les propriété des ListObjects comme ça, vu que je n'ai rien vu de similaire sur ce forum ou d'autres.


VB:
Sub Import_Fichier_relève_ListObjects()
'


Dim Mois As String
Mois = MonthName(Month(Date))

Dim Année As String
Année = Year(Date)

' Ouvrir le fichier de relève
    Workbooks.Open Filename:= _
        "S:\DSTG\STL\SAG\LOT3_EAU\2023\03_EXPLOITATION ET MAINTENANCE\6_Relevé mensuel_compteurs\01_RELEVE_COMPTEURS\Stock Fichiers de Relève\" & Année & "_Relève des compteurs à Intégrer.xlsx"
    Worksheets(Mois).Activate
    
' Ignorer les erreurs
    'On Error Resume Next

Dim Wbk_Index As Workbook
Set...

R3n0W

XLDnaute Nouveau
Avec Plaisir, voici donc les fichiers anonymisés :
Dans l'absolu j'adorerai pouvoir utiliser les Range faisant référence aux colonnes des tableaux directement. Je trouve cette possibilité EXCEL-lente.
 

Pièces jointes

  • µ.zip
    94 KB · Affichages: 6

R3n0W

XLDnaute Nouveau
Je ne comprends pas où ça pèche :

VB:
Dim Wbk_Index As Workbook
Set Wbk_Index = Workbooks("2023_Index Compteurs Annuel - Copie.xlsm")
Dim Ws_Index As Worksheet
Set Ws_Index = Wbk_Index.Worksheets("Relevés Compteurs")
Dim NumComptIndex As Range
Set NumComptIndex = Ws_Index.ListObjects("Index_Compteurs").ListColumns("N° COMPTEUR PHYSIQUE").DataBodyRange
Dim IndexMois As Range
Set IndexMois = Ws_Index.ListObjects("Index_Compteurs").ListColumns("Index " & MOIS).DataBodyRange



Dim Wbk_Releve As Workbook
Set Wbk_Releve = Workbooks("Relève des Compteurs à intégrer.xlsx")
Dim Ws_Releve As Worksheet
Set Ws_Releve = Wbk_Releve.Worksheets(MOIS)

Dim NumComptReleve As Range
Set NumComptReleve = Ws_Releve.ListObjects(MOIS).ListColumns("N° COMPTEUR PHYSIQUE").DataBodyRange

Dim IndexReleve As Range
Set IndexReleve = Ws_Releve.ListObjects(MOIS).ListColumns("RELEVE").DataBodyRange


  For Each Cel In NumComptReleve
    
        If Cel.Value = NumComptIndex.Cel.Value Then
        IndexMois.Cells.Value = IndexReleve.Cells.Value
        End If
    Next
 

R3n0W

XLDnaute Nouveau
Aller, je vous donne la réponse, je suis sûr que cela pourra servir.
J'ai pas l'impression que beaucoup de personnes sachent utiliser les propriété des ListObjects comme ça, vu que je n'ai rien vu de similaire sur ce forum ou d'autres.


VB:
Sub Import_Fichier_relève_ListObjects()
'


Dim Mois As String
Mois = MonthName(Month(Date))

Dim Année As String
Année = Year(Date)

' Ouvrir le fichier de relève
    Workbooks.Open Filename:= _
        "S:\DSTG\STL\SAG\LOT3_EAU\2023\03_EXPLOITATION ET MAINTENANCE\6_Relevé mensuel_compteurs\01_RELEVE_COMPTEURS\Stock Fichiers de Relève\" & Année & "_Relève des compteurs à Intégrer.xlsx"
    Worksheets(Mois).Activate
    
' Ignorer les erreurs
    'On Error Resume Next

Dim Wbk_Index As Workbook
Set Wbk_Index = Workbooks(Année & "_Index Compteurs Annuel.xlsm")

Dim Ws_Index As Worksheet
Set Ws_Index = Wbk_Index.Worksheets("Relevés Compteurs")

Dim NumComptIndex As Range
Set NumComptIndex = Ws_Index.ListObjects("Index_Compteurs").ListColumns("N° COMPTEUR PHYSIQUE").DataBodyRange

Dim IndexMois As Range
Set IndexMois = Ws_Index.ListObjects("Index_Compteurs").ListColumns("Index " & Mois).DataBodyRange



Dim Wbk_Releve As Workbook
Set Wbk_Releve = Workbooks(Année & "_Relève des Compteurs à intégrer.xlsx")

Dim Ws_Releve As Worksheet
Set Ws_Releve = Wbk_Releve.Worksheets(Mois)


Dim NumComptReleve As Range
Set NumComptReleve = Ws_Releve.ListObjects(Mois).ListColumns("N° COMPTEUR PHYSIQUE").DataBodyRange

Dim IndexReleve As Range
Set IndexReleve = Ws_Releve.ListObjects(Mois).ListColumns("RELEVE").DataBodyRange


Dim NumCR As Range
Dim NumCI As Range

    For Each NumCR In NumComptReleve
        For Each NumCI In NumComptIndex 'A ajouter : and "Manuel" in colonne "RELEVE"
    
            If NumCR = NumCI Then
            
                IndexMois.Rows(NumCI.Row - 1).Value = IndexReleve.Rows(NumCR.Row).Value
            End If
        Next
    Next
    

Wbk_Releve.Close (True)

MsgBox ("C'est fait !")
End Sub

Je ne pense pas reposter sur ce forum avant un bon moment en tout cas..

@Modo : sujet clôt ! :)
 

Membres actuellement en ligne

Statistiques des forums

Discussions
314 204
Messages
2 107 186
Membres
109 771
dernier inscrit
herve1979