Problème de gestion de cotisation

Le 01/12/2023 à 10:04

Bonjour à tous,

J'ai une problème sur mon macro pour transférer un montant de cotisation (2000) d'une table ("Tbl_Basse") à une autre table ("Tbl_Cot" ou "Tbl_Cot2024") en fonction de certaines conditions liées à l'année dans la colonne G de "Tbl_Basse".

J'ai joint le fichier. Merci d'avance pour votre aide.

6formulaire-cotisation-2.xlsm (36.30 Ko)

voici le code:

Sub Transfert_Cotisation() ' Déclaration des variables Dim wsBase As Worksheet Dim wsCotisation As Worksheet Dim tblBasse As ListObject Dim tblCot As ListObject Dim tblCot2024 As ListObject Dim nomColBasse As Range Dim nomColCot As Range Dim nomColCot2024 As Range Dim ligneDebut As Long Dim ligneFin As Long Dim annee As Integer ' Définir les feuilles de calcul Set wsBase = ThisWorkbook.Sheets("Base") Set wsCotisation = ThisWorkbook.Sheets("Cotisation") ' Définir les tableaux Set tblBasse = wsBase.ListObjects("Tbl_Basse") Set tblCot = wsCotisation.ListObjects("Tbl_Cot") Set tblCot2024 = wsCotisation.ListObjects("Tbl_Cot2024") ' Définir les colonnes de nom Set nomColBasse = tblBasse.ListColumns("Nom").DataBodyRange Set nomColCot = tblCot.ListColumns("NOM").DataBodyRange Set nomColCot2024 = tblCot2024.ListColumns("NOM").DataBodyRange ' Itérer sur chaque ligne du tableau "Tbl_Basse" For Each cell In nomColBasse ' Vérifier si l'année dans la colonne G de "Tbl_Basse" est 2023 ou 2024 annee = cell.Offset(0, 6).Value If annee = 2023 Or annee = 2024 Then ' Utiliser On Error Resume Next pour gérer les erreurs de recherche dans Match On Error Resume Next ' Trouver la ligne correspondante dans "Tbl_Cot" ou "Tbl_Cot2024" If annee = 2023 Then ligneDebut = Application.Match(CStr(cell.Value), nomColCot, 0) Else ligneDebut = Application.Match(CStr(cell.Value), nomColCot2024, 0) End If On Error GoTo 0 ' Revenir à la gestion normale des erreurs ' Vérifier si la correspondance a été trouvée If ligneDebut <> 0 Then ' Corriger le calcul de ligneFin ligneFin = ligneDebut + IIf(IsNumeric(cell.Offset(0, 4).Value) And IsNumeric(cell.Offset(0, 5).Value), cell.Offset(0, 4).Value - cell.Offset(0, 5).Value, 0) ' Boucler sur la plage de lignes dans la table correspondante et mettre à jour la colonne 7 avec la valeur 2000 If annee = 2023 Then For i = ligneDebut To ligneFin tblCot.DataBodyRange.Cells(i, 7).Value = 2000 Next i Else For i = ligneDebut To ligneFin tblCot2024.DataBodyRange.Cells(i, 7).Value = 2000 Next i End If Else ' Gérer le cas où la correspondance n'a pas été trouvée MsgBox "Aucune correspondance trouvée pour " & cell.Value & " dans la table correspondante." End If End If Next cell End Sub

Le 01/12/2023 à 11:14

Bonjour et bienvenu sur le forum

Pour mettre un code utiliser </> dans la barre de menu

Je ne comprend pas ce que tu souhaite faire . c'est quoi lignefin

cell.Offset(0, 4) et cell.Offset(0, 5) sont des mois Janvier, Décembre...

donc non numérique...

A+ François

Le 01/12/2023 à 11:34

Bonjour fanfan38,

C'est un code que j'ai récupéré sur chatGPT mais il en a toujours un bug sur le code ligneFin = ligneDebut + IIf(IsNumeric(cell.Offset(0, 4).Value) And IsNumeric(cell.Offset(0, 5).Value), cell.Offset(0, 4).Value - cell.Offset(0, 5).Value, 0)

Le 01/12/2023 à 11:47
Sub Transfert_Cotisation()
    ' Déclaration des variables
    Dim wsBase As Worksheet
    Dim wsCotisation As Worksheet
    Dim tblBasse As ListObject
    Dim tblCot As ListObject
    Dim tblCot2024 As ListObject
    Dim nomColBasse As Range
    Dim nomColCot As Range
    Dim nomColCot2024 As Range
    Dim ligneDebut As Long
    Dim ligneFin As Long
    Dim annee As Integer

    ' Définir les feuilles de calcul
    Set wsBase = ThisWorkbook.Sheets("Base")
    Set wsCotisation = ThisWorkbook.Sheets("Cotisation")

    ' Définir les tableaux
    Set tblBasse = wsBase.ListObjects("Tbl_Basse")
    Set tblCot = wsCotisation.ListObjects("Tbl_Cot")
    Set tblCot2024 = wsCotisation.ListObjects("Tbl_Cot2024")

    ' Définir les colonnes de nom
    Set nomColBasse = tblBasse.ListColumns("Nom").DataBodyRange
    Set nomColCot = tblCot.ListColumns("NOM").DataBodyRange
    Set nomColCot2024 = tblCot2024.ListColumns("NOM").DataBodyRange

    ' Itérer sur chaque ligne du tableau "Tbl_Basse"
    For Each cell In nomColBasse
        ' Vérifier si l'année dans la colonne G de "Tbl_Basse" est 2023 ou 2024
        annee = cell.Offset(0, 6).Value
        If annee = 2023 Or annee = 2024 Then
            ' Utiliser On Error Resume Next pour gérer les erreurs de recherche dans Match
            On Error Resume Next
            ' Trouver la ligne correspondante dans "Tbl_Cot" ou "Tbl_Cot2024"
            If annee = 2023 Then
                ligneDebut = Application.Match(CStr(cell.Value), nomColCot, 0)
            Else
                ligneDebut = Application.Match(CStr(cell.Value), nomColCot2024, 0)
            End If
            On Error GoTo 0 ' Revenir à la gestion normale des erreurs

            ' Vérifier si la correspondance a été trouvée
            If ligneDebut <> 0 Then
                ' Corriger le calcul de ligneFin
                ligneFin = ligneDebut + IIf(IsNumeric(cell.Offset(0, 4).Value) And IsNumeric(cell.Offset(0, 5).Value), cell.Offset(0, 4).Value - cell.Offset(0, 5).Value, 0)
                ' Boucler sur la plage de lignes dans la table correspondante et mettre à jour la colonne 7 avec la valeur 2000
                If annee = 2023 Then
                    For i = ligneDebut To ligneFin
                        tblCot.DataBodyRange.Cells(i, 7).Value = 2000
                    Next i
                Else
                    For i = ligneDebut To ligneFin
                        tblCot2024.DataBodyRange.Cells(i, 7).Value = 2000
                    Next i
                End If
            Else
                ' Gérer le cas où la correspondance n'a pas été trouvée
                MsgBox "Aucune correspondance trouvée pour " & cell.Value & " dans la table correspondante."
            End If
        End If
    Next cell
End Sub
Le 01/12/2023 à 12:21

bonjour Aprenti XL, FanFan,

Sub Transfert_Cotisation()
     ' Déclaration des variables
     Dim LigneDebut As Variant, ColonneDebut As Variant, Cell As Range, Tbl As ListObject, i

     For Each Cell In Range("TBL_Basse").ListObject.ListColumns("Nom").DataBodyRange.Cells     ' Itérer sur chaque ligne du tableau "Tbl_Basse"
          Select Case Cell.Offset(0, 6).Value     'Vérifier si l'année dans la colonne G de "Tbl_Basse" est 2023 ou 2024
               Case 2023: Set Tbl = Range("Tbl_Cot").ListObject
               Case 2024: Set Tbl = Range("Tbl_Cot2024").ListObject
               Case Else: Set Tbl = Nothing
          End Select

          If Not Tbl Is Nothing Then
               LigneDebut = Application.Match(Cell.Value, Tbl.ListColumns("Nom").DataBodyRange, 0) 'quelle ligne
               ColonneDebut = Application.Match(Cell.Offset(, 4).Value, Tbl.HeaderRowRange, 0) 'quelle colonne

               If IsNumeric(LigneDebut) And IsNumeric(ColonneDebut) Then  ' Vérifier si la correspondance a été trouvée
                    For i = ColonneDebut To Application.Min(Tbl.ListColumns.Count, ColonneDebut + Cell.Offset(, 1).Value - 1)  ' Corriger le calcul de ligneFin
                         Tbl.DataBodyRange.Cells(LigneDebut, i).Value = Cell.Offset(, 3).Value2
                    Next i
               Else
                    MsgBox "Aucune correspondance trouvée pour " & Cell.Value & " dans la table correspondante."  ' Gérer le cas où la correspondance n'a pas été trouvée
               End If
          End If
     Next Cell
End Sub
3formulaire-cotisation-2.xlsm (40.54 Ko)
Le 01/12/2023 à 12:53

re,

j'ai lu votre profil, peut-être l'utilisation d'un tableau croisé dynamique est un outil que vous devez connaitre.

Voici une macro pour brisser vos données dans le tableau "TBL_Brisser" qui est la source pour le TCD dans la feuille cotisation.

comme cà vous n'aurez aucun problème avec des paiement de novembre à juin.

4formulaire-cotisation-2.xlsm (51.55 Ko)
Le 01/12/2023 à 14:08

Bonjour BsAlv,

Merci pour votre aide et conseille.

Rechercher des sujets similaires à "probleme gestion cotisation"