Macro VBA - Transformer tableau 1 en tableau 2

Bonjour,

Je reviens vers vous car j'ai réussi à faire fonctionner le code dans mon fichier de test. Cependant, lorsque je l'exécute dans mon fichier d'export qui sera à chaque fois la vrai base cela ne fonctionne pas voici mon code :

Option Explicit

Sub recap()
  Dim i As Long, lig As Long, col As Byte, nbjour As Byte, ctrl As Boolean
  Dim t As Long, n As Long
  Dim ws As Worksheet
  Dim lo As ListObject
  Dim LastRow As Long
  Dim LastCol As Long
  Dim DataRange As Range
  On Error Resume Next
  Sheets(1).Name = "Détail"
      ' Définir la feuille de travail active
    ' Définir la feuille de travail active
    Set ws = ActiveSheet

    ' Trouver la dernière ligne avec des données
    LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    ' Trouver la dernière colonne avec des données
    LastCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column

    ' Vérifier si le nombre d'objets de liste sur la feuille est de 0
    If ws.ListObjects.Count = 0 Then
        ' Définir la plage de données en fonction de la dernière ligne et la dernière colonne
        Set DataRange = ws.Range(ws.Cells(1, 1), ws.Cells(LastRow, LastCol))

        ' Ajouter un nouvel objet de liste avec la plage dynamique
        Set lo = ws.ListObjects.Add(xlSrcRange, DataRange, , xlYes)
        lo.Name = "détail"
    End If
  If FeuilleExiste("Nb jours") = False Then
    Sheets("Détail").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Nb jours"
    Sheets("Nb jours").ListObjects(1).Name = "nbjours"
    [nbjours].Columns(10).Delete
    [nbjours].Columns(9).Delete
    Sheets("Nb jours").Shapes.Range(Array("Button 1")).Delete
  End If
  If FeuilleExiste("Nb cas") = False Then
    Sheets("Détail").Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = "Nb cas"
    Sheets("Nb cas").ListObjects(1).Name = "nbcas"
    Range("nbcas[[#Headers],[Nb jour]]").FormulaR1C1 = "Nb Cas"
    [nbcas].Columns(10).Delete
    [nbcas].Columns(9).Delete
    Range("nbcas[[#Headers],[Date début]]").FormulaR1C1 = "Date début rapport"
    Range("nbcas[[#Headers],[Date fin]]").FormulaR1C1 = "Date fin rapport"
    Sheets("Nb cas").Shapes.Range(Array("Button 1")).Delete
  End If
  If [nbjours].Item(1, 1) <> "" Then [nbjours].Delete 'on efface nbjours
  If [nbcas].Item(1, 1) <> "" Then [nbcas].Delete 'on efface nbcas

  ctrl = True
  Dim totalG As Double ' Variable pour stocker la somme accumulée de la colonne G
  For i = 1 To [détail].Rows.Count
   If [détail].Item(i, 8) = "" Then
    ctrl = True
   Else
    If ctrl = True Or [nbjours].Item(lig, 3) <> [détail].Item(i, 3) Then
     If [nbjours].Item(1, 1) <> "" Then lig = [nbjours].Rows.Count + 1 Else lig = 1 'RECAP premiere ligne vide
     For col = 1 To 8: [nbjours].Item(lig, col) = [détail].Item(i, col): Next
     nbjour = 1
     totalG = [détail].Item(i, 7) / [détail].Item(i, 4) ' Calcul de la division
    [nbjours].Item(lig, 7) = totalG ' Stockage de la somme accumulée dans la colonne G (index 7) du deuxième tableau
     ctrl = False: n = 0
     For t = 1 To [nbcas].Rows.Count
       If [nbcas].Item(t, 3) = [détail].Item(i, 3) And [nbcas].Item(t, 8) = [détail].Item(i, 8) Then
         n = t
         Exit For
       End If
     Next
     If n = 0 Then
       If [nbcas].Item(1, 1) <> "" Then n = [nbcas].Rows.Count + 1 Else n = 1 'type premiere ligne vide
     End If
     For col = 1 To 4: [nbcas].Item(n, col) = [détail].Item(i, col): Next
     If [nbcas].Item(n, 5) = "" Then [nbcas].Item(n, 5) = [détail].Item(i, 9)
     [nbcas].Item(n, 6) = [détail].Item(i, 10)
     [nbcas].Item(n, 7) = [nbcas].Item(n, 7) + 1
     [nbcas].Item(n, 8) = [détail].Item(i, 8)
    Else
        nbjour = nbjour + 1
        totalG = totalG + ([détail].Item(i, 7) / [détail].Item(i, 4)) ' Accumulation de la somme
        [nbjours].Item(lig, 7) = totalG ' Stockage de la somme accumulée dans la colonne G (index 7) du deuxième tableau
        [nbjours].Item(lig, 6) = [détail].Item(i, 6)

     'nbjour = nbjour + 1'
     '[nbjours].Item(lig, 7) = nbjour'
     '[nbjours].Item(lig, 6) = [détail].Item(i, 6)'
     '[nbcas].Item(n, 6) = [détail].Item(i, 10)'
    End If
   End If
  Next
  MsgBox ("Transfert terminé")
End Sub

Public Function FeuilleExiste(FeuilleAVerifier As String) As Boolean 'fonction qui vérifie si la "FeuilleAVerifier" existe dans le Classeur actif
  On Error GoTo SiErreur
  Dim Feuille
    FeuilleExiste = False
    For Each Feuille In Sheets
        If UCase(Feuille.Name) = UCase(FeuilleAVerifier) Then
            FeuilleExiste = True
            Exit Function
        End If
    Next Feuille
  Exit Function
SiErreur:
    FeuilleExiste = CVErr(xlErrNA)
End Function

Mon export a exactement le même nombre de colonne mais à la seule différence de mes fichiers tests que vous pourrez voir dans l'historique des échanges. C'est que lorsque la valeur en colonne 3 donc (nom-prénom) passe à une autre personne, les colonnes Date début et Date fin reviennent au début ce sont pas une continuité de date comme dans les fichiers que j'ai partagé dernièrement. La colonne 9 et 10 ne changent chez personne ils sont définie lors de l'export c'est donc un export de tel à tel date et donc les dates de suivies se trouve durant cette période donc si les périodes définies sont du 01.01.2023 au 30.06.2023 en colonne 9 et 10 on va avoir des lignes exemple (colonne 5 et 6):

01.01.2023 01.01.2023

02.01.2023 02.01.2023

etc... jusqu'à la ligne

30.06.2023 30.06.2023

Ensuite dans l'ordre la valeur (nom-prénom) en colonne 3 change et ça recommence pareil.

Donc je voudrais réussir à faire fonctionner le code ici présent qui fonctionne sur un fichier (voir un des fichiers des échanges antérieurs) mais pour ce cas là car pour le moment ça ne fonctionne pas et j'ai essayé d'ajouté à cette partie du code

  For i = 1 To [détail].Rows.Count
   If [détail].Item(i, 8) = "" Then
    ctrl = True
   Else

la condition suivante

For i = 1 To [détail].Rows.Count
   If [détail].Item(i, 8) = "" Or [détail].Item(i, 1) = "" Or [détail].Item(i, 4) = "" Or [détail].Item(i, 7) = "" Then
    ctrl = True
   Else

mais rien n'y fait pour que le système fasse correctement la sortie que j'attends la feuile Nb jours et Nb cas mais sur cette export.

En vous remerciant d'avance pour votre aide . :)

Rechercher des sujets similaires à "macro vba transformer tableau"