Code d'erreur sur macro

Le 15/12/2022 à 14:08

bonjour à tous,

tout nouveau sur le forum, je poste ici ma 1ère demande et vous remercie par avance du temps que vous accorderez à mon problème.

voici ce qui m'amène :

depuis plusieurs année je fonctionne avec une macro réalisée par un ami. Cet ami est malheureusement décédé brutalement et la macro en question plante avec "erreur d'exécution 13". Je n'arrive pas à comprendre pourquoi. Vous trouverez ci-dessous la macro en question avec en rouge, l'endroit ou ça plante.

je vous joint par ailleurs un bout de fichier en aillant pris le soin d'enlever les noms et prénoms et clubs.

encore merci par avance

Option Explicit
Option Base 1
Function IsInArray(stringToBeFound As String, arr As Variant, ColumnToCheck As Integer) As Long
Dim j As Long

For j = UBound(arr, 1) To LBound(arr, 1) Step -1 'rows
If arr(j, ColumnToCheck) = stringToBeFound Then
IsInArray = j
Exit Function
End If
Next j

IsInArray = -1

End Function
Public Sub agePremiereLicence()
Dim i, j, trouveAnneePassee, trouveAnneeProchaine, dernièreLigne As Long
Dim saisonSource, saisonDest, anneeSource, data, result() As Variant
Dim licence, nomclub As String
Dim dico, cleAnnee, cleAnneePassee, cleAnneeProchaine As Variant
Set dico = CreateObject("Scripting.Dictionary")

j = 1

dernièreLigne = Sheets("travail").Range("A125000").End(xlUp).Row

data = Sheets("travail").Range("A1:S" & CStr(dernièreLigne)).Value
ReDim result(UBound(data, 1), UBound(data, 2))

For i = 2 To UBound(data, 1)
dico.Item(data(i, 1) + data(i, 7)) = data(i, 4)
Next

For i = 2 To UBound(data, 1)

anneeSource = Left(data(i, 1), 4)
licence = data(i, 7)
nomclub = data(i, 4)

cleAnneeProchaine = CStr(CInt(anneeSource) + 1) + "-" + CStr(CInt(anneeSource) + 2) + licence
cleAnneePassee = CStr(CInt(anneeSource) - 1) + "-" + CStr(CInt(anneeSource)) + licence
cleAnnee = CStr(CInt(anneeSource)) + "-" + CStr(CInt(anneeSource) + 1) + licence

trouveAnneePassee = dico.Exists(cleAnneePassee)
trouveAnneeProchaine = dico.Exists(cleAnneeProchaine)

If (Not trouveAnneeProchaine) Then
Sheets("travail").Cells(i, 21) = "arrêt"
End If

If (trouveAnneeProchaine) Then
Sheets("travail").Cells(i, 21) = "continu"
End If

If (trouveAnneeProchaine And dico(cleAnneeProchaine) <> nomclub) Then
Sheets("travail").Cells(i, 21) = "départ"
End If

If (Not trouveAnneePassee And anneeSource <> "2005") Then
Sheets("travail").Cells(i, 20) = "nouveau"
End If

If (trouveAnneePassee) Then
If (dico(cleAnneePassee) <> nomclub) Then
Sheets("travail").Cells(i, 20) = "arrivée"
Else
Sheets("travail").Cells(i, 20) = "renouvellement"
End If
End If


Application.StatusBar = "Exécution de la macro. Ligne lue : " & i

Next

End Sub

5probleme-macro-effectif-2.xlsx (12.82 Ko)
Le 15/12/2022 à 14:47

Bonjour,

Je pense que tu n'as pas du lire la charte, tu aurais su mettre ton code conformément...

Et pour ton problème, renomme le nom de l'onglet (Feuil1 -> travail)

image

Bonne journée

Le 15/12/2022 à 14:57

Désolé pour l'erreur de mise en forme. Je re-édite donc avec la bonne configuration.

9probleme-macro-effectif-2.xlsx (12.85 Ko)

Sur mon fichier d'origine, la feuille est bien nommée "travail". J'avais zappé de le changé. Je remet en PJ le doc avec le bon nom de feuille.

Option Explicit
Option Base 1
Function IsInArray(stringToBeFound As String, arr As Variant, ColumnToCheck As Integer) As Long
Dim j As Long

For j = UBound(arr, 1) To LBound(arr, 1) Step -1   'rows
    If arr(j, ColumnToCheck) = stringToBeFound Then
        IsInArray = j
        Exit Function
    End If
Next j

IsInArray = -1

End Function
Public Sub agePremiereLicence()
Dim i, j, trouveAnneePassee, trouveAnneeProchaine, dernièreLigne As Long
Dim saisonSource, saisonDest, anneeSource, data, result() As Variant
Dim licence, nomclub As String
Dim dico, cleAnnee, cleAnneePassee, cleAnneeProchaine As Variant
Set dico = CreateObject("Scripting.Dictionary")

j = 1

dernièreLigne = Sheets("travail").Range("A125000").End(xlUp).Row

data = Sheets("travail").Range("A1:S" & CStr(dernièreLigne)).Value
ReDim result(UBound(data, 1), UBound(data, 2))

For i = 2 To UBound(data, 1)
dico.Item(data(i, 1) + data(i, 7)) = data(i, 4)
Next

For i = 2 To UBound(data, 1)

    anneeSource = Left(data(i, 1), 4)
    licence = data(i, 7)
    nomclub = data(i, 4)

    cleAnneeProchaine = CStr(CInt(anneeSource) + 1) + "-" + CStr(CInt(anneeSource) + 2) + licence
    cleAnneePassee = CStr(CInt(anneeSource) - 1) + "-" + CStr(CInt(anneeSource)) + licence
    cleAnnee = CStr(CInt(anneeSource)) + "-" + CStr(CInt(anneeSource) + 1) + licence

    trouveAnneePassee = dico.Exists(cleAnneePassee)
    trouveAnneeProchaine = dico.Exists(cleAnneeProchaine)

    If (Not trouveAnneeProchaine) Then
        Sheets("travail").Cells(i, 21) = "arrêt"
    End If

    If (trouveAnneeProchaine) Then
        Sheets("travail").Cells(i, 21) = "continu"
    End If

    If (trouveAnneeProchaine And dico(cleAnneeProchaine) <> nomclub) Then
        Sheets("travail").Cells(i, 21) = "départ"
    End If

    If (Not trouveAnneePassee And anneeSource <> "2005") Then
        Sheets("travail").Cells(i, 20) = "nouveau"
    End If

    If (trouveAnneePassee) Then
        If (dico(cleAnneePassee) <> nomclub) Then
            Sheets("travail").Cells(i, 20) = "arrivée"
        Else
            Sheets("travail").Cells(i, 20) = "renouvellement"
        End If
    End If

    Application.StatusBar = "Exécution de la macro. Ligne lue : " & i

Next

End Sub
Le 15/12/2022 à 15:05

Bonjour,

Essayez ceci:

Public Sub agePremiereLicence()
    Dim i As Long, j As Long, TrouveAnneePassee As Long, TrouveAnneeProchaine As Long, DernièreLigne As Long
    Dim SaisonSource  As Range, SaisonDest As Range
    Dim CleAnnee As String, CleAnneePassee As String, CleAnneeProchaine As String, Licence As String, NomClub As String, AnneeSource As String
    Dim Data As Variant
    Dim Dico As Object
    Set Dico = CreateObject("Scripting.Dictionary")

    j = 1
    DernièreLigne = Sheets("travail").Range("A" & Rows.Count).End(xlUp).Row
    Data = Sheets("travail").Range("A1:S" & CStr(DernièreLigne)).Value
    For i = LBound(Data) + 1 To UBound(Data)
        Dico(Data(i, 1) & Data(i, 7)) = Data(i, 4)
    Next
    For i = 2 To UBound(Data, 1)
        AnneeSource = Left(Data(i, 1), 4)
        Licence = Data(i, 7)
        NomClub = Data(i, 4)
        CleAnneeProchaine = CStr(CInt(AnneeSource) + 1) & "-" & CStr(CInt(AnneeSource) + 2) & Licence
        CleAnneePassee = CStr(CInt(AnneeSource) - 1) & "-" & CStr(CInt(AnneeSource)) & Licence
        CleAnnee = CStr(CInt(AnneeSource)) & "-" & CStr(CInt(AnneeSource) + 1) & Licence
        TrouveAnneePassee = Dico.Exists(CleAnneePassee)
        TrouveAnneeProchaine = Dico.Exists(CleAnneeProchaine)
        If (Not TrouveAnneeProchaine) Then
            Sheets("travail").Cells(i, 21) = "arrêt"
        End If
        If (TrouveAnneeProchaine) Then Sheets("travail").Cells(i, 21) = "continu"
        If (TrouveAnneeProchaine And Dico(CleAnneeProchaine) <> NomClub) Then Sheets("travail").Cells(i, 21) = "départ"
        If (Not TrouveAnneePassee And AnneeSource <> "2005") Then Sheets("travail").Cells(i, 20) = "nouveau"
        If (TrouveAnneePassee) Then
            If (Dico(CleAnneePassee) <> NomClub) Then
                Sheets("travail").Cells(i, 20) = "arrivée"
            Else
                Sheets("travail").Cells(i, 20) = "renouvellement"
            End If
        End If
        Application.StatusBar = "Exécution de la macro. Ligne lue : " & i
    Next
End Sub

Cdlt

Le 15/12/2022 à 15:08

Re-,

La macro fonctionne parfaitement

pour l'utiliser, il faut que le code soit dans un fichier prenant en charge les macros (*.xlsm)

J'ai mis ce code dans votre fichier, rajouté un bouton bleu, et enregistré sous ce format

Bonne journée

7probleme-macro-effectif-2.xlsm (23.58 Ko)
Le 15/12/2022 à 17:01

@cousinHub : la macro fonctionne effectivement sur ce bout de fichier mais pas sur mon fichier global

@Arturo83 : j'ai essayé le code proposé et ça semble bien fonctionner

Un énorme merci à tous les 2 pour le temps consacré à mon problème.

Rechercher des sujets similaires à "code erreur macro"