Macro avec tableau de corrrespondance [résolu]

[tben08]

Bonsoir à tous,

voici mon problème, j'ai 2 fichiers, la société alpha et la société beta. Dans chaque fichier les budgets mensuels.

Les 2 fichiers ne sont pas identiques, dans la colonne A sur l'un des fichiers il y a plus de lignes. J'ai mis 2 fichiers mais j'en aurais beaucoup ce qui veut dire qu'il faut boucler sur chaque fichier et qu'en fonction du nom (si alpha ou betta ) la traitement sera différent (mais ça je pourrais le faire)

j'ai un 3 ème fichier(modele) avec 2 tables de correspondance 1 pour alpha et l'autre pour betta et un onglet pour vous montrer ce que je souhaite obtenir.

Dans mon tableau, j'ai donc besoin du numéro de societé, du code correspondant au libellé (table de correspondance), le mois et le montant. Le problème que je rencontre c'est comment afficher mon code de libellé. Mon libellé et code de libellé sont fixe ils seront toujours sur les mêmes lignes. et je ne souhaite traiter seulement les lignes ou il y a les libélles. Tout doit se passer dans le fichier modele, je ne peux mpas modifier les fichier alpha et betta.

J'espère avoir réussi à vous faire comprendre mon problème et vous avoir donné l'envie de m'aider

Merci d'avance pour votre aide.

 

[tben08]

Re : Macro avec tableau de corrrespondance

j'ai eu ma réponse sur un autre forum (heureusement) donc voici la réponse à ma demande

Sub Recupere()

' Demande si tous les fichiers sont fermés
        If MsgBox("Avez vous des fichiers de budget ouverts?", vbYesNo, "Demande de confirmation") = vbYes Then
        MsgBox ("Veuiller fermer les fichiers concernés et relancer le traitement." & "Traitement annulé.")
        Exit Sub
        End If
' Ouverture du chemin d'accès aux fichiers
        Dim Chemin As String, Fichier As String
        Dim Ws As Worksheet
        Dim T1, T2, T3(), Indice As Integer, J As Long, I As Integer
        Feuil4.Cells.ClearContents
        Application.ScreenUpdating = False
        Set Ws = Sheets("Base")
        Ws.Columns("A:E").Clear
        Ws.Range("A1:E1") = Array("numsocieté", "numcode", "Libellé", "mois", "montant")
        Dim objShell As Object, objFolder As Object, oFolderItem As Object
            
         
        Set objShell = CreateObject("Shell.Application")
        Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
         
        On Error Resume Next
        Set oFolderItem = objFolder.Items.Item
        Chemin = oFolderItem.Path & "\"
         
        Fichier = Dir(Chemin & "*.xlsx")
' vérification que des fichiers ne sont pas ouverts
        If VerifOuvertureClasseur(Fichier) Then
        MsgBox ("Des fichiers sont ouverts, merci de bien vouloir les fermer et de relancer le traitement.")
        Exit Sub
        End If
          
 'début de la boucle
          Do While Fichier <> ""
  
           If Fichier <> ThisWorkbook.Name Then
      If InStr(1, Fichier, "EHPAD", vbTextCompare) > 0 Then
        With Sheets("MODELE EHPAD")
          T1 = .Range("A2:C" & .Range("A" & Rows.Count).End(xlUp).Row)
        End With
      ElseIf InStr(1, Fichier, "CLINEA", vbTextCompare) > 0 Then
        With Sheets("MODELE CLINEA")
          T1 = .Range("A2:C" & .Range("A" & Rows.Count).End(xlUp).Row)
        End With
      Else
        Erase T1
        MsgBox "Type de fichier inconnu"
      End If
      If IsArray(T1) Then
        With Workbooks.Open(Chemin & Fichier)
          With .Sheets(1)
            T2 = .Range("A1:O" & .Range("A" & Rows.Count).End(xlUp).Row)
          End With
          .Close savechanges:=False
        End With
         Indice = 0: Erase T3
        For J = 1 To UBound(T1)
          If T1(J, 2) <> "" Then
            For I = 1 To 12
              If T2(T1(J, 3), 2 + I) <> 0 Then      ' Montant différent de 0
                Indice = Indice + 1
                ReDim Preserve T3(1 To 5, 1 To Indice)
                Ws.Columns("A").NumberFormat = "@"
                T3(1, Indice) = "0" & (Split(T2(3, 3), "/")(0))           ' Numéro de société
                T3(2, Indice) = T1(J, 1)            ' Numéro de code
                T3(3, Indice) = T1(J, 2)            ' Libellé
                T3(4, Indice) = MonthName(I)        ' Le mois
                T3(5, Indice) = (T2(T1(J, 3), 2 + I)) * 1000 ' Montant
              End If
            Next I
          End If
        Next J
        Ws.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(T3, 2), UBound(T3)) = Application.Transpose(T3)
      End If
    End If
    Fichier = Dir()
  Loop
        Ws.Columns("A:E").AutoFit
        Ws.Columns("E").NumberFormat = "#,##0.0"
      MsgBox ("traitement terminé")
    End Sub

Function VerifOuvertureClasseur(Fichier As String) As Boolean
Dim n As Integer
On Error Resume Next
n = FreeFile()
Open Fichier For Input Lock Read As #n
Close n
If Err.Number = 0 Then VerifOuvertureClasseur = False
If Err.Number = 70 Then VerifOuvertureClasseur = True
On Error GoTo 0
End Function