Utilisation variable tablo

Le 14/03/2021 à 13:48

Bonjour à tous,

Je sollicite votre aide, car en voulant participer à ce sujet:

https://forum.excel-pratique.com/excel/reporting-synthese-2017-2019-154110

Je me retrouve confronté à un problème que je ne parviens pas à résoudre.

Dans mon fichier test ci-après, ma macro affiche bien le résultat souhaité.

12test.xlsm (283.87 Ko)

Les feuilles sont toutes situées sur le même classeur.

Le demandeur souhaite que la macro s'exécute depuis un autre classeur:

Les données étant sous le même format que mon fichier test, j'applique la même macro.

L'affichage ne correspond pas au résultat attendu (comme dans mon fichier test).

Toutes mes tentatives sont restées vaines, je ne comprends pas ce qui cloche.

Ci-joint les 2 fichiers:

7synthese-reporting-2017-2019.xlsm (58.10 Ko)
6107-vf-excel-backtesting-08-06-2018.xlsm (246.67 Ko)

La feuille "Exemple reporting" du classeur "synthese-reporting-2017-2019.xlsm" doit recevoir les données issues des feuilles définies du classeur "107-vf-excel-backtesting-08-06-2018.xlsm".

Pourriez-vous me dire ce qui cloche dans mon code ?

Sub Bouton1_Cliquer()
 Dim dl As Long, i As Long, x As Integer
 Dim wk As Workbook, wkdest As Workbook, sh As Worksheet
 Dim tablo, tabloR(), tabfeuil, madate As Date

  Application.ScreenUpdating = False

 Set wkdest = Workbooks("synthese-reporting-2017-2019.xlsm") '.............................définit le classeur de destination

 If Not FichOuvert("107-vf-excel-backtesting-08-06-2018.xlsm") Then '......................teste si le classeur source est ouvert
 '.........................................................................................fonction FichOuvert
    MsgBox "Le classeur" & Chr(10) & "107-vf-excel-backtesting-08-06-2018.xlsm" & Chr(10) & "n'est pas ouvert", 32, "Transfert des données impossible": Exit Sub
 Else

  With wkdest.Sheets("Exemple reporting")
   .Range("B2").CurrentRegion.Offset(1, 0).ClearContents '.................................efface les données existantes
  End With

  Set wk = Workbooks("107-vf-excel-backtesting-08-06-2018.xlsm") '.........................définit le classeur source
   madate = Left(Right(wk.Name, 15), 10) '.................................................récupère la date du classeur
  Set tabfeuil = wk.Sheets(Array("Signal +8", "Signal +7", "Signal +6", "Signal +5", _
  "Signal +4", "Signal +3", "Signal +2", "Signal +1", "Signal 0")) '.......................feuilles à traiter

      For Each sh In tabfeuil '............................................................boucle sur les feuilles du classeur
            tablo = sh.Range("B2:S" & sh.Range("B" & Rows.Count).End(xlUp).Row) '..........définit le tablo
            ReDim tabloR(1 To (UBound(tablo, 1) - 1) * (UBound(tablo, 2) - 1), 1 To 12) '..dimensionne tabloR

                iR = 1
          For i = 2 To UBound(tablo, 1)
           For j = 4 To UBound(tablo, 2)
            If tablo(i, j) <> "" And tablo(i, 2) > 380 Then '..............................si NB APP>380 et si valeur présente
                tabloR(iR, 1) = Format(madate, "mm/dd/yyyy") '.............................date comprise dans nom classeur source
                tabloR(iR, 2) = tablo(i, 1) '..............................................championnat
                tabloR(iR, 3) = tablo(i, 2) '..............................................NB APP
                tabloR(iR, 4) = tablo(i, 3) '..............................................Villes
                tabloR(iR, 5) = tablo(1, j) '..............................................STAT (intitulé colonne feuille source)
               Select Case tablo(1, j) '...................................................en fonction de STAT
                Case "OVER 1,5", "OVER 2,5", "OVER 3,5", "OVER 4,5" '......................on écrit la valeur dans colonne correspondante
                 tabloR(iR, 6) = tablo(i, j) '.............................................UNDER 3,5
                Case "UNDER 1,5", "UNDER 2,5", "UNDER 3,5", "UNDER 4,5"
                 tabloR(iR, 7) = tablo(i, j) '.............................................OVER 1,5
                Case "OVER 0,5 HT", "OVER 1,5 HT"
                  tabloR(iR, 8) = tablo(i, j) '............................................UNDER 1,5 HT
                Case "UNDER 0,5 HT", "UNDER 1,5 HT"
                  tabloR(iR, 9) = tablo(i, j) '............................................OVER 0,5 HT
                Case "MAX VICT"
                  tabloR(iR, 10) = tablo(i, j) '...........................................VIC
                Case "MAX NUL"
                  tabloR(iR, 11) = tablo(i, j) '...........................................NUL
                Case "MAX DEF"
                  tabloR(iR, 12) = tablo(i, j) '...........................................DEF
               End Select
                  iR = iR + 1
            End If
           Next j
          Next i
           On Error Resume Next
          'on écrit les données sur la feuille Exemple reporting du classeur synthese-reporting-2017-2019.xlsm
           wkdest.Sheets("Exemple reporting").Range("B" & Sheets("Exemple reporting").Range("B" & Rows.Count).End(xlUp).Row + 1).Resize(UBound(tabloR, 2), 12) = Application.Transpose(tabloR)
           Erase tablo: Erase tabloR '.....................................................libère la mémoire
      Next sh '............................................................................prochaine feuille,on recommence
 End If
End Sub

Function FichOuvert(F As String) As Boolean '.....fonction pour tester si fichier ouvert
'myDearFriend!  -  www.mdf-xlpages.com
    On Error Resume Next
    FichOuvert = Not Workbooks(F) Is Nothing
End Function

Un grand merci à l' âme charitable qui voudra bien m'aider,

Bon dimanche !

Le 14/03/2021 à 15:05

Bonjour,

Pas sûr d'avoir bien compris le besoin ...

M'enfin > un essai ...

Sub AutrePrésentation()

Application.ScreenUpdating = False
Set Wk = Workbooks("107-vf-excel-backtesting-08-06-2018.xlsm")  ' S'assurer que ce fichier sera ouvert pour ne pas avoir d'erreur
madate = Left(Right(Wk.Name, 15), 10)

 Sheets("Exemple reporting").Range("B2").CurrentRegion.Offset(1, 0).ClearContents

Set tabFeuil = Wk.Sheets(Array("Signal +8", "Signal +7", "Signal +6", "Signal +5", "Signal +4", "Signal +3", "Signal +2", "Signal +1", "Signal 0"))

' ...
' ...
' ...
' ...

ric

Le 14/03/2021 à 15:28

Bonjour le fil, bonjour le forum,

Une autre proposition :

Sub Bouton1_Cliquer()
Dim dl As Long, i As Long, x As Integer, iR As Integer
Dim CS As Workbook, CD As Workbook, O As Worksheet, OS As Worksheet, OD As Worksheet
Dim tablo, tabloR(), tabfeuil, madate As Date, dest As Range

Application.ScreenUpdating = False
Set CD = ThisWorkbook 'Classeur destination CD
Set OD = CD.Worksheets("Exemple reporting") 'onglet destination OD
On Error Resume Next 'gestion des erreurs
Set CS = Workbooks("107-vf-excel-backtesting-08-06-2018.xlsm") 'définit le classeur source
If Err <> 0 Then 'condition si erreur
    Err.Clear 'supprime l erreur
    MsgBox "Le classeur" & Chr(10) & "107-vf-excel-backtesting-08-06-2018.xlsm" & Chr(10) & "n'est pas ouvert ! Transfert des données impossible.": Exit Sub 'message 'sort de la procédure
Else 'sinon
    On Error GoTo 0 'annule al gestion des erreurs
    OD.Range("B2").CurrentRegion.Offset(1, 0).ClearContents 'efface les données existantes
    madate = DateSerial(2018, 6, 8) 'pourquoi une variable puisque le nom du fichier est écrit en dur ?!
    Set tabfeuil = CS.Sheets(Array("Signal +8", "Signal +7", "Signal +6", "Signal +5", _
       "Signal +4", "Signal +3", "Signal +2", "Signal +1", "Signal 0")) 'feuilles à traiter
    For Each O In tabfeuil 'boucle sur les feuilles du classeur
        tablo = O.Range("B2:S" & O.Range("B" & Rows.Count).End(xlUp).Row) 'définit le tablo
        ReDim tabloR(1 To (UBound(tablo, 1)), 1 To 12) 'dimensionne tabloR
        iR = 1
        For i = 2 To UBound(tablo, 1)
            J = O.Cells(i + 1, Application.Columns.Count).End(xlToLeft).Column
            If tablo(i, 2) > 380 Then 'si NB APP>380 et si valeur présente
                tabloR(iR, 1) = Format(madate, "mm/dd/yyyy") 'date comprise dans nom classeur source
                tabloR(iR, 2) = tablo(i, 1) 'championnat
                tabloR(iR, 3) = tablo(i, 2) 'NB APP
                tabloR(iR, 4) = tablo(i, 3) 'Villes
                tabloR(iR, 5) = tablo(1, J) 'STAT (intitulé colonne feuille source)
                Select Case J 'en fonction de STAT
                    Case 5 To 8 'on écrit la valeur dans colonne correspondante
                        tabloR(iR, 6) = tablo(i, J - 1) 'UNDER 3,5
                    Case 9 To 12
                        tabloR(iR, 7) = tablo(i, J - 1) 'OVER 1,5
                    Case 13 To 14
                        tabloR(iR, 8) = tablo(i, J - 1) 'UNDER 1,5 HT
                    Case 15 To 16
                        tabloR(iR, 9) = tablo(i, J - 1) 'OVER 0,5 HT
                    Case 17
                        tabloR(iR, 10) = tablo(i, J - 1) 'VIC
                    Case 18
                        tabloR(iR, 11) = tablo(i, J - 1) 'NUL
                    Case 19
                        tabloR(iR, 12) = tablo(i, J - 1) 'DEF
                End Select
                iR = iR + 1
            End If
        Next i
        On Error Resume Next
        Set dest = OD.Cells(Application.Rows.Count, "B").End(xlUp).Offset(1, 0)
        dest.Resize(UBound(tabloR, 1), 12).Value = tabloR
        'on écrit les données sur la feuille Exemple reporting du classeur synthese-reporting-2017-2019.xlsm
        Erase tablo: Erase tabloR 'libère la mémoire
    Next O 'prochaine feuille,on recommence
End If
Application.ScreenUpdating = True
End Sub
Le 14/03/2021 à 18:40

Re,

Merci ric et Thauthème pour vos réponses,

@ ric:

Pas sûr d'avoir bien compris le besoin ...

En fait, c'est assez complexe.

  • On boucle sur les feuilles du classeur "107-vf-excel-backtesting-06-08-2018.xlsm" de "Signal +8 à Signal 0".
  • Si dans la colonne NB APP, la valeur est > 380 alors dans la feuille Exemple reporting du classeur synthese-reporting-2017-2019 on reporte:
  • La date comprise dans le nom du classeur source (donc ici 08-06-2018)
  • Le nom du championnat
  • NB APP
  • L'équipe
  • Statistique : correspond à l'intitulé de la colonne où se situe la valeur ( pour La Serena(Chili): under 1,5 HT).

Puis, c'est là que ça se complique un peu:

  • En fonction de STATISTIQUE : on reporte la valeur dans la colonne correspondante:
correspondance

Donc ici pour La Serena : STAT = under 1,5 HT, on écrit donc la valeur (8) en colonne J (over 0,5 HT); ne me demande pas pourquoi, c'est la demande

  • Bien entendu, si plusieurs valeurs sur la ligne, une ligne par valeur.

Le résultat souhaité est obtenu sur mon fichier TEST.

Dans mon fichier TEST, cela fonctionne correctement, mais si j'utilise 2 classeurs, mes données s'inscrivent n'importe comment.

Source:

1

Résultat souhaité:

2

Résultat obtenu:

3

Cordialement,

Le 14/03/2021 à 18:56

Re,

@ ThauThème:

Merci pour ton implication, malheureusement, bien que les données s'inscrivent correctement, elles sont fausses, mais comme je n'ai pas suffisamment détailler ma demande, tu ne pouvais pas deviner.

De plus, j'obtiens une erreur si je rajoute/modifie une ligne dans une feuille source:

capture capture2

Ce que tu obtiens:

t1

Ce que j'obtiens:

t2

Comme je l'ai stipulé dans mon précédent post, avec mon fichier TEST, tout est OK.

Mais le fait de bosser sur 2 classeurs fait que mes données s'inscrivent n'importe comment,

Je dois passer à côté de quelque chose.....J'en reste là pour aujourd'hui....mais demain à tête reposée et en mixant nos 2 codes, j’arriverai peut-être à quelque chose,

madate = DateSerial(2018, 6, 8) 'pourquoi une variable puisque le nom du fichier est écrit en dur ?!

Ici, on n'utilise qu'un seul classeur source, hors il semblerait que le demandeur boucle ensuite sur plusieurs classeurs nommés de manière similaire....

[EDIT]: il semblerait que ce soit OK ainsi:

Sub Bouton1()
Dim dl As Long, i As Long, x As Integer, iR As Integer
Dim CS As Workbook, CD As Workbook, O As Worksheet, OS As Worksheet, OD As Worksheet
Dim tablo, tabloR(), tabfeuil, madate As Date, dest As Range

Application.ScreenUpdating = False
Set CD = ThisWorkbook 'Classeur destination CD
Set OD = CD.Worksheets("Exemple reporting") 'onglet destination OD
On Error Resume Next 'gestion des erreurs
Set CS = Workbooks("107-vf-excel-backtesting-08-06-2018.xlsm") 'définit le classeur source
If Err <> 0 Then 'condition si erreur
    Err.Clear 'supprime l erreur
    MsgBox "Le classeur" & Chr(10) & "107-vf-excel-backtesting-08-06-2018.xlsm" & Chr(10) & "n'est pas ouvert ! Transfert des données impossible.": Exit Sub 'message 'sort de la procédure
Else 'sinon
    On Error GoTo 0 'annule al gestion des erreurs
    OD.Range("B2").CurrentRegion.Offset(1, 0).ClearContents 'efface les données existantes
    madate = DateSerial(2018, 6, 8) 'pourquoi une variable puisque le nom du fichier est écrit en dur ?!
    Set tabfeuil = CS.Sheets(Array("Signal +8", "Signal +7", "Signal +6", "Signal +5", _
       "Signal +4", "Signal +3", "Signal +2", "Signal +1", "Signal 0")) 'feuilles à traiter
    For Each O In tabfeuil 'boucle sur les feuilles du classeur
        tablo = O.Range("B2:S" & O.Range("B" & Rows.Count).End(xlUp).Row) 'définit le tablo
         ReDim tabloR(1 To (UBound(tablo, 1) - 1) * (UBound(tablo, 2) - 1), 1 To 12)  'dimensionne tabloR
           iR = 1
          For i = 2 To UBound(tablo, 1)
           For J = 4 To UBound(tablo, 2)
            If tablo(i, J) <> "" And tablo(i, 2) > 380 Then '..............................si NB APP>380 et si valeur présente
                tabloR(iR, 1) = Format(madate, "mm/dd/yyyy") '.............................date comprise dans nom classeur source
                tabloR(iR, 2) = tablo(i, 1) '..............................................championnat
                tabloR(iR, 3) = tablo(i, 2) '..............................................NB APP
                tabloR(iR, 4) = tablo(i, 3) '..............................................Villes
                tabloR(iR, 5) = tablo(1, J) '..............................................STAT (intitulé colonne feuille source)
               Select Case tablo(1, J) '...................................................en fonction de STAT
                Case "OVER 1,5", "OVER 2,5", "OVER 3,5", "OVER 4,5" '......................on écrit la valeur dans colonne correspondante
                 tabloR(iR, 6) = tablo(i, J) '.............................................UNDER 3,5
                Case "UNDER 1,5", "UNDER 2,5", "UNDER 3,5", "UNDER 4,5"
                 tabloR(iR, 7) = tablo(i, J) '.............................................OVER 1,5
                Case "OVER 0,5 HT", "OVER 1,5 HT"
                  tabloR(iR, 8) = tablo(i, J) '............................................UNDER 1,5 HT
                Case "UNDER 0,5 HT", "UNDER 1,5 HT"
                  tabloR(iR, 9) = tablo(i, J) '............................................OVER 0,5 HT
                Case "MAX VICT"
                  tabloR(iR, 10) = tablo(i, J) '...........................................VIC
                Case "MAX NUL"
                  tabloR(iR, 11) = tablo(i, J) '...........................................NUL
                Case "MAX DEF"
                  tabloR(iR, 12) = tablo(i, J) '...........................................DEF
               End Select
                  iR = iR + 1
            End If
           Next J
          Next i
        On Error Resume Next
        Set dest = OD.Cells(Application.Rows.Count, "B").End(xlUp).Offset(1, 0)
        dest.Resize(UBound(tabloR, 1), 12).Value = tabloR
        'on écrit les données sur la feuille Exemple reporting du classeur synthese-reporting-2017-2019.xlsm
        Erase tablo: Erase tabloR 'libère la mémoire
    Next O 'prochaine feuille,on recommence
End If
Application.ScreenUpdating = True
End Sub

Je ferai quelques tests plus approndis demain pour confirmer, merci pour tout,

Amitiés,

Le 15/03/2021 à 16:06

Bonjour ric, ThauThème,

J'ai fait plusieurs tests, tout semble ok : je passe donc le sujet en résolu,

Après avoir relu vos propositions, et en décortiquant le code de ThauThème, je pense avoir cerné mon erreur.

  • J'avais mal déclaré mon classeur de destination
  • J'avais mal déclaré ma cellule de destination

J'aime bien la gestion d'erreur qui m'évite d'utiliser la fonction FichOuvert,

Mon code, revu et corrigé:

Sub Reporting()
 Dim iR As Long, i As Long, j As Long
 Dim wk As Workbook, wkdest As Workbook, sh As Worksheet, dest as range
 Dim tablo, tabloR(), tabfeuil, madate As Date

  Application.ScreenUpdating = False

 Set wkdest = ThisWorkbook '......................................................................définit le classeur de destination
  On Error Resume Next '..........................................................................gestion des erreurs
 Set wk = Workbooks("107-vf-excel-backtesting-08-06-2018.xlsm") '.................................définit le classeur source
   If Err <> 0 Then '.............................................................................condition si erreur
    Err.Clear '...................................................................................supprime l erreur
    MsgBox "Le classeur" & Chr(10) & "107-vf-excel-backtesting-08-06-2018.xlsm" & Chr(10) & "n'est pas ouvert", 32, "Transfert des données impossible": Exit Sub
   Else
    On Error GoTo 0 '.............................................................................annule al gestion des erreurs
    wkdest.Sheets("Exemple reporting").Range("B2").CurrentRegion.Offset(1, 0).ClearContents '.....efface les données existantes

    madate = Left(Right(wk.Name, 15), 10) '.......................................................récupère la date du classeur
     Set tabfeuil = wk.Sheets(Array("Signal +8", "Signal +7", "Signal +6", "Signal +5", _
      "Signal +4", "Signal +3", "Signal +2", "Signal +1", "Signal 0")) '..........................feuilles à traiter

      For Each sh In tabfeuil '...................................................................boucle sur les feuilles du classeur
            tablo = sh.Range("B2:S" & sh.Range("B" & Rows.Count).End(xlUp).Row) '.................définit le tablo
            ReDim tabloR(1 To (UBound(tablo, 1) - 1) * (UBound(tablo, 2) - 1), 1 To 12) '.........dimensionne tabloR

                iR = 1
          For i = 2 To UBound(tablo, 1)
           For j = 4 To UBound(tablo, 2)
            If tablo(i, j) <> "" And tablo(i, 2) > 380 Then '.....................................si NB APP>380 et si valeur présente
                tabloR(iR, 1) = Format(madate, "mm/dd/yyyy") '....................................date comprise dans nom classeur source
                tabloR(iR, 2) = tablo(i, 1) '.....................................................championnat
                tabloR(iR, 3) = tablo(i, 2) '.....................................................NB APP
                tabloR(iR, 4) = tablo(i, 3) '.....................................................Villes
                tabloR(iR, 5) = tablo(1, j) '.....................................................STAT (intitulé colonne feuille source)
               Select Case tablo(1, j) '..........................................................en fonction de STAT
                Case "OVER 1,5", "OVER 2,5", "OVER 3,5", "OVER 4,5" '.............................on écrit la valeur dans colonne correspondante
                 tabloR(iR, 6) = tablo(i, j) '....................................................UNDER 3,5
                Case "UNDER 1,5", "UNDER 2,5", "UNDER 3,5", "UNDER 4,5"
                 tabloR(iR, 7) = tablo(i, j) '....................................................OVER 1,5
                Case "OVER 0,5 HT", "OVER 1,5 HT"
                  tabloR(iR, 8) = tablo(i, j) '...................................................UNDER 1,5 HT
                Case "UNDER 0,5 HT", "UNDER 1,5 HT"
                  tabloR(iR, 9) = tablo(i, j) '...................................................OVER 0,5 HT
                Case "MAX VICT"
                  tabloR(iR, 10) = tablo(i, j) '..................................................VIC
                Case "MAX NUL"
                  tabloR(iR, 11) = tablo(i, j) '..................................................NUL
                Case "MAX DEF"
                  tabloR(iR, 12) = tablo(i, j) '..................................................DEF
               End Select
                  iR = iR + 1
            End If
           Next j
          Next i
           On Error Resume Next
          'on écrit les données sur la feuille Exemple reporting du classeur synthese-reporting-2017-2019.xlsm
           Set dest = wkdest.Worksheets("Exemple reporting").Cells(Application.Rows.Count, "B").End(xlUp).Offset(1, 0)
               dest.Resize(UBound(tabloR, 1), 12).Value = tabloR
           Erase tablo: Erase tabloR '...........................................................libère la mémoire
      Next sh '..................................................................................prochaine feuille,on recommence
    End If
End Sub

Encore un grand merci à vous, au plaisir de vous croiser (lire) sur le forum.

Amitiés,

Rechercher des sujets similaires à "utilisation variable tablo"