Utilisation variable tablo
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é.
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:
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 !
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
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
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:
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:
Résultat souhaité:
Résultat obtenu:
Cordialement,
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:
Ce que tu obtiens:
Ce que j'obtiens:
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,
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,