Problème debogage

Le 31/10/2023 à 14:48

Bonjour,

je rencontre un problème de débogage que je n'arrive pas à résoudre

en PJ mon tableau

merci par avance pour votre aide

Bien cordialement

2test-med1.zip (803.99 Ko)
Le 31/10/2023 à 15:08

Bonjour,

Pourras-tu copier le code de ta macro ici ?

Peux tu également nous expliquer ce que tu cherches à faire ?

CDL,
Parrish

Le 31/10/2023 à 15:10

Bonjour,

Ceci peut-être:

    Private Sub Worksheet_Activate()
    Dim tbU, newtbU() 'définit les tableaux de valeurs
    Dim i%, k%, lig%, x%
    Dim wsh, sh As Worksheet
    Dim lo As ListObject
    Dim colNomPrenom As Integer, colGrade As Integer, colAbsence As Integer, colDebutAbsence As Integer, _
    colFinAbsence As Integer, colRemplacePar As Integer, colSpecificites As Integer, colObservations As Integer

    Application.ScreenUpdating = False
    wsh = Array("Imagerie", "Consultations", "USIC USIN", "Cardio froide", "UNV Neuro Cardio", "Dialyse", "EOHH", "Médecine Pneumo", "USP EVP", "HDJ", "Coronarographie") 'tu peux rajouter des feuilles ici(tableau contenant le nom des feuilles à traiter)
    Set lo = Sheets("Absences").ListObjects("tb_absences") 'définit le tableau structuré de la feuille Absences (nommé tb_absences)

    With lo
        If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete 'efface les données de la feuille Absences
    End With

    For x = LBound(wsh) To UBound(wsh) 'boucle sur chaque nom du  tableau wsh
        For Each sh In ThisWorkbook.Worksheets 'boucle sur chaue feuille du classeur
            If sh.Name Like wsh(x) Then 'si le nom de la feuille du classeur fait partie du tableau wsh
                Set tbU = sh.Range("A4:T" & sh.Range("E" & Rows.Count).End(xlUp).Row) 'on définit le tableau de données
                k = 0 '............................................index de départ

                colNomPrenom = getCol("Nom & Prénom", sh, 2)
                colGrade = getCol("Grade", sh, 2)
                colAbsence = getCol("Absence", sh, 2)
                colDebutAbsence = getCol("Début D'absence", sh, 2)
                colFinAbsence = getCol("Fin d'Absence", sh, 2)
                colRemplacePar = getCol("Remplacé par", sh, 2)
                colSpecificites = getCol("Spécificités", sh, 2)
                colObservations = getCol("Observations", sh, 2)

                ReDim newtbU(0 To UBound(tbU, 1), 1 To 9) '........on crée un tableau temporaire
                For i = 1 To UBound(tbU, 1) '.....................on boucle sur les lignes du tableau de données
                    If tbU(i, colNomPrenom) <> "" And tbU(i, colAbsence) <> "" Then '....si Nom/prénom et Absences remplis
                        newtbU(k, 1) = tbU(i, colNomPrenom)  '....nom prénom
                        newtbU(k, 2) = sh.Name    '...............service
                        newtbU(k, 3) = tbU(i, colGrade)  '........grade
                        newtbU(k, 4) = tbU(i, colAbsence)  '......absence
                        newtbU(k, 5) = tbU(i, colDebutAbsence)  '.début absence
                        newtbU(k, 6) = tbU(i, colFinAbsence)  '...fin absence
                        Select Case sh.Name
                        Case "Imagerie", "Consultations", "USIC USIN", "Cardio froide", "UNV Neuro Cardio", "Dialyse", "EOHH", "Médecine Pneumo", "USP EVP", "HDJ", "Coronarographie" '........si la feuille se nomme Pharmacie ou Laboratoire
                            newtbU(k, 7) = IIf(tbU(i, colRemplacePar) <> "", tbU(i, colRemplacePar), "A remplacer !")  'remplacé par
                        Case Else '..............................sinon
                            newtbU(k, 7) = tbU(i, colRemplacePar)
                        End Select
                        newtbU(k, 8) = tbU(i, colSpecificites) '..observations
                        newtbU(k, 9) = tbU(i, colObservations) '..observations
                        k = k + 1 '...............................incrémente l'index
                    End If
                Next i '..........................................prochaine ligne du tableau de valeur

                If k > 0 Then '...................................si tableau temporaire comporte au moins 1 ligne
                On Error Resume Next
                    With lo
                        .ListRows.Add '............rajoute une ligne au tableau de la feuille Absences
                        lig = .ListColumns(1).Range.Find("", SearchDirection:=xlNext).Row '...définit la première ligne vide
                        Sheets("Absences").Range("A" & lig).Resize(k, UBound(newtbU, 2)).Value = newtbU '.....écrit les données du tableau temporaire
                    End With
                End If
            End If
        Next sh '................................................prochaine feuille du classeur
    Next x '.....................................................prochaine valeur du tableau wsh

     '.................efface tous les tableaux (libère la mémoire)
    Set tbU = Nothing
    Erase newtbU
End Sub

Cdlt

Le 31/10/2023 à 15:28

Bonjour,

j'aimerai que les absences de la feuille médecine s'incrémentent directement dans la feuille absence. la formule

Private Sub Worksheet_Activate()
Dim tbU, newtbU() 'définit les tableaux de valeurs
Dim i%, k%, lig%, x%
Dim wsh, sh As Worksheet
Dim lo As ListObject
Dim colNomPrenom As Integer, colGrade As Integer, colAbsence As Integer, colDebutAbsence As Integer, _
colFinAbsence As Integer, colRemplacePar As Integer, colSpecificites As Integer, colObservations As Integer

Application.ScreenUpdating = False

wsh = Array("Imagerie", "Consultations", "USIC USIN", "Cardio froide", "UNV Neuro Cardio", "Dialyse", "EOHH", "Médecine Pneumo", "USP EVP", "HDJ", "Coronarographie") 'tu peux rajouter des feuilles ici(tableau contenant le nom des feuilles à traiter)
Set lo = Sheets("Absences").ListObjects("tb_absences") 'définit le tableau structuré de la feuille Absences (nommé tb_absences)

With lo
If Not .DataBodyRange Is Nothing Then .DataBodyRange.Delete 'efface les données de la feuille Absences
End With

For x = LBound(wsh) To UBound(wsh) 'boucle sur chaque nom du tableau wsh
For Each sh In ThisWorkbook.Worksheets 'boucle sur chaue feuille du classeur
If sh.Name Like wsh(x) Then 'si le nom de la feuille du classeur fait partie du tableau wsh
tbU = sh.Range("A4:T" & sh.Range("E" & Rows.Count).End(xlUp).Row) 'on définit le tableau de données
k = 0 '............................................index de départ

colNomPrenom = getCol("Nom & Prénom", sh, 2)
colGrade = getCol("Grade", sh, 2)
colAbsence = getCol("Absence", sh, 2)
colDebutAbsence = getCol("Début D'absence", sh, 2)
colFinAbsence = getCol("Fin d'Absence", sh, 2)
colRemplacePar = getCol("Remplacé par", sh, 2)
colSpecificites = getCol("Spécificités", sh, 2)
colObservations = getCol("Observations", sh, 2)

ReDim newtbU(0 To UBound(tbU, 1), 1 To 9) '........on crée un tableau temporaire
For i = 1 To UBound(tbU, 1) '.....................on boucle sur les lignes du tableau de données
If tbU(i, colNomPrenom) <> "" And tbU(i, colAbsence) <> "" Then '....si Nom/prénom et Absences remplis
newtbU(k, 1) = tbU(i, colNomPrenom) '....nom prénom
newtbU(k, 2) = sh.Name '...............service
newtbU(k, 3) = tbU(i, colGrade) '........grade
newtbU(k, 4) = tbU(i, colAbsence) '......absence
newtbU(k, 5) = tbU(i, colDebutAbsence) '.début absence
newtbU(k, 6) = tbU(i, colFinAbsence) '...fin absence
Select Case sh.Name
Case "Imagerie", "Consultations", "USIC USIN", "Cardio froide", "UNV Neuro Cardio", "Dialyse", "EOHH", "Médecine Pneumo", "USP EVP", "HDJ", "Coronarographie" '........si la feuille se nomme Pharmacie ou Laboratoire
newtbU(k, 7) = IIf(tbU(i, colRemplacePar) <> "", tbU(i, colRemplacePar), "A remplacer !") 'remplacé par
Case Else '..............................sinon
newtbU(k, 7) = tbU(i, colRemplacePar)
End Select
newtbU(k, 8) = tbU(i, colSpecificites) '..observations
newtbU(k, 9) = tbU(i, colObservations) '..observations
k = k + 1 '...............................incrémente l'index
End If
Next i '..........................................prochaine ligne du tableau de valeur

If k > 0 Then '...................................si tableau temporaire comporte au moins 1 ligne
On Error Resume Next
With lo
.ListRows.Add '............rajoute une ligne au tableau de la feuille Absences
lig = .ListColumns(1).Range.Find("", SearchDirection:=xlNext).Row '...définit la première ligne vide
Sheets("Absences").Range("A" & lig).Resize(k, UBound(newtbU, 2)).Value = newtbU '.....écrit les données du tableau temporaire
End With
End If
End If
Next sh '................................................prochaine feuille du classeur
Next x '.....................................................prochaine valeur du tableau wsh

Erase tbU: Erase newtbU: Set wsh = Nothing '.................efface tous les tableaux (libère la mémoire)
End Sub

Function getCol(nomCol As String, Wks As Worksheet, ligEnTete As Integer) As Integer
Dim colFin As Integer, numCol As Integer

With Wks
colFin = .Cells(ligEnTete, .Columns.Count).End(xlToLeft).Column

For j = 1 To colFin
If LCase(.Cells(ligEnTete, j)) = LCase(nomCol) Then
numCol = j
GoTo fin
End If
Next j
End With

fin:
getCol = numCol
End Function

Merci par avance

Cordialement

Le 31/10/2023 à 18:38

Bonsoir à tous,

@MANGO19 : il eût été plus simple de fournir ton dernier fichier (qui était fonctionnel) et de mentionner les modifications à apporter.

Le souci, c'est que ton tableau (feuille Médecine 1) n'est plus cohérent:

  • 2 colonnes GRADE ? (déjà mentionné dans un post précédent ?)
image
  • plus de colonnes Début d'absence (ligne de code désactivée)
  • plus de colonnes Fin d'absence (ligne de code désactivée)
image
  • pas de colonnes Spécificités (ligne de code désactivée)
  • pas de colonnes Observations (ligne de code désactivée)
image
  • Tu as modifié le titre Remplacé par--> Remplacé(e) par (corrigé)
 colRemplacePar = getCol("Remplacé(e) par", sh, 2)
  • La feuille Médecine 1 ne figure pas dans le tableau wsh ni dans le Select Case sh.Name (corrigé)
wsh = Array("Imagerie", "Consultations", "USIC USIN", "Cardio froide", "UNV Neuro Cardio", "Dialyse", "EOHH", "Médecine 1", "Médecine Pneumo", "USP EVP", "HDJ", "Coronarographie") 'tu peux rajouter des feuilles ici(tableau contenant le nom des feuilles à traiter)
 Case "Imagerie", "Consultations", "USIC USIN", "Cardio froide", "UNV Neuro Cardio", "Dialyse", "EOHH", "Médecine 1", "Médecine Pneumo", "USP EVP", "HDJ", "Coronarographie" '........si la feuille se nomme....

Donc forcément, ton code ne pourra pas fonctionner.

Ci-joint ton fichier avec quelques corrections,

5test-med1.zip (802.74 Ko)

cordialement,

Rechercher des sujets similaires à "probleme debogage"