Titre du sujet : Re: Tri de tableaux de longueurs variables sur différentes feuilles
par myDearFriend! le 06/08/2009 22:59:57
Bonsoir GGlyon, le Forum,
Tu trouveras ci-joint une proposition pour ta demande, en espérant que j'ai bien interprété tes indications...
N'ayant pas compris pourquoi tu avais scindé le traitement en 3 phases (3 boutons) alors que visiblement elles devaient être lancées successivement, et pour simplifier le code, j'ai rassemblé l'ensemble du traitement (Finance, Commandes et Factures) en une seule procédure "Traitement()" que tu trouveras toujours dans le module de code de la feuille "Finances". L'ensemble se déclenche donc avec l'unique bouton "Actualiser".
Je te laisse prendre connaissance du code VBA utilisé.
Pas franchement convaincu par le choix de certaines de tes variables (je pense notamment à X, Z, n, k par exemple), je les ai toutefois laissées telles quelles pour que tu puisses conserver tes repères dans tout ceci.
Sub Traitement()
'----------------------------------------------------------
' myDearFriend! - www.mdf-xlpages.com
' 06/08/2009
'----------------------------------------------------------
Dim Sh As Worksheet
Dim DateFinProjet As Date, DateVirement As Date, DateCalendrier As Date, DateCommande As Date, DateFacture As Date
Dim DerniereCommande As Long, DerniereFacture As Long
Dim Virement As Single, CommandeTTC As Single, FactureTTC As Single
Dim i As Byte, k As Byte, n As Byte, X As Byte, Z As Byte
'On fige l'affichage pour accélérer le traitement
Application.ScreenUpdating = False
Range("A4:BI69").ClearContents
Range("A2:J3").Interior.Color = RGB(40, 215, 90)
'Mise en forme des dates du calendrier pour que celles qui sont dépassées apparaissent en gris
For Z = 12 To 83
With Cells(3, Z)
DateCalendrier = .Value
Select Case DateSerial(Year(Date), Month(Date), 1)
Case Is > DateCalendrier
.Font.ColorIndex = 16
Case Is = DateCalendrier
.Font.ColorIndex = 30
Case Else
.Font.ColorIndex = 1
End Select
End With
Next Z
'Couleurs des tableaux
For k = 4 To 69 Step 3
'FINANCE--------------------------------------------------------
Rows(k).Interior.Color = RGB(200, 255, 110)
'COMMANDES------------------------------------------------------
Rows(k + 1).Interior.Color = RGB(255, 255, 255)
Range(Cells(k + 1, 1), Cells(k + 1, 4)).Merge
Cells(k + 1, 1).HorizontalAlignment = xlRight
Cells(k + 1, 1).Value = "Commandes"
Range(Cells(k + 1, 12), Cells(k + 1, 83)).Font.ColorIndex = 3
'FACTURES-------------------------------------------------------
Rows(k + 2).Interior.ColorIndex = 34 'RGB(40, 215, 200)
Range(Cells(k + 2, 1), Cells(k + 2, 4)).Merge
Cells(k + 2, 1).HorizontalAlignment = xlRight
Cells(k + 2, 1).Value = "Factures"
Range(Cells(k + 2, 12), Cells(k + 2, 83)).Font.ColorIndex = 10
Next k
X = 4
'recherche sur chacune des feuilles du classeur
For Each Sh In Worksheets
If Sh.Name <> "Finances" And Sh.Name <> "Général" Then
'Savoir si le projet est encore actif
DateFinProjet = Sh.Range("B13").Value
If DateFinProjet > Date Then
'FINANCES-----------------------------------------------------------
'Récupérer les infos du projet
Cells(X, 2).Value = Sh.Range("B7").Value 'Organisme financeur
Cells(X, 3).Value = Sh.Range("L5").Value 'Acronyme Projet
Cells(X, 4).Value = Sh.Range("K2").Value 'Année du projet
Cells(X, 5).Value = Sh.Range("B9").Value 'Référence du projet
Cells(X, 6).Value = Sh.Range("I2").Value 'Gestion
Cells(X, 7).Value = Sh.Range("B12").Value 'Date de début de projet
Cells(X, 8).Value = Sh.Range("B13").Value 'Date de fin de projet
Cells(X, 9).Value = Sh.Range("B24").Value 'Montant total
For i = 10 To 30 Step 10
If Sh.Cells(40 + i, 4).Value = "UMR" Then
Cells(X, 10).Value = Sh.Cells(48 + i, 7).Value
Exit For
End If
Next i
'Partie concernant le versement des subventions
'Ajouter les infos concernant les référence projets répertoriées
For n = 29 To 34
'Trouver les dates de virement et les sommes correspondantes pour un projet
With Sh.Cells(n, 11)
If .Value <> "" Then
DateVirement = .Value
DateVirement = DateSerial(Year(DateVirement), Month(DateVirement), 1)
Virement = .Offset(0, 1).Value
End If
End With
'Recherche le mois de la date du virement dans la feuille finance et inscrire le montant
For Z = 12 To 83
DateCalendrier = Cells(3, Z).Value
If DateCalendrier = DateVirement Then
Cells(X, Z).Value = Virement
Exit For
End If
Next Z
Next n
'COMMANDES----------------------------------------------------------
'Recherche de la dernière cellule remplie pour les commandes
DerniereCommande = Sh.Cells(Sh.Rows.Count, 18).End(xlUp).Row
If DerniereCommande > 153 Then
'Parcourir toutes les commandes
For n = 154 To DerniereCommande
With Sh.Cells(n, 18)
DateCommande = .Value
DateCommande = DateSerial(Year(DateCommande), Month(DateCommande), 1)
CommandeTTC = .Offset(0, 1).Value
End With
'Recherche le mois dans la feuille finances et inscrire le montant de commande
'Si < au premier mois du tableau (< 01/2009)
If DateCommande < Cells(3, 12).Value Then
Cells(X + 1, 11).Value = Cells(X + 1, 11).Value + CommandeTTC
Else
'Sinon
For Z = 12 To 83
DateCalendrier = Cells(3, Z).Value
If DateCalendrier = DateCommande Then
Cells(X + 1, Z).Value = Cells(X + 1, Z).Value + CommandeTTC
Exit For
End If
Next Z
End If
Next n
End If
'FACTURES-----------------------------------------------------------
'Recherche de la dernière cellule remplie pour les factures
DerniereFacture = Sh.Cells(Sh.Rows.Count, 28).End(xlUp).Row
If DerniereFacture > 153 Then
'Parcourir toutes les factures
For n = 154 To DerniereFacture
With Sh.Cells(n, 28)
DateFacture = .Value
DateFacture = DateSerial(Year(DateFacture), Month(DateFacture), 1)
FactureTTC = .Offset(0, 7).Value
End With
'Recherche le mois dans la feuille finances et inscrire le montant de facture
'Si < au premier mois du tableau (< 01/2009)
If DateFacture < Cells(3, 12).Value Then
Cells(X + 2, 11).Value = Cells(X + 2, 11).Value + FactureTTC
Else
'Sinon
For Z = 12 To 83
DateCalendrier = Cells(3, Z).Value
If DateCalendrier = DateFacture Then
Cells(X + 2, Z).Value = Cells(X + 2, Z).Value + FactureTTC
Exit For
End If
Next Z
End If
Next n
End If
X = X + 3
End If
End If
Next Sh
Application.ScreenUpdating = True
End Sub
Par rapport à ton travail, voici quelques infos qui pourront t'être utiles je pense :
Lorsque tu écris par exemple :
Dim DateFinProjet, DateActuelle, DateVirement As Date
Sache que seule DateVirement est déclarée comme type Date. Les autres (DateFinProjet, DateActuelle) seront de type Variant !
Il te faut impérativement écrire :
Dim DateFinProjet As Date, DateActuelle As Date, DateVirement As Date
Par ailleurs, concernant l'utilisation de la propriété ThisWorkbook ou ActiveWorkbook : comme ton code VBA n'agit que sur le classeur dans lequel se trouve le code lui-même, tu n'as pas besoin d'utiliser cette propriété, elle est implicite. Tu verras que je ne l'ai pas utilisé dans le code ci-dessus.
De plus, comme tu as fait le choix de créer ta procédure de traitement dans le module de code Private de la feuille "Finances", tu n'as pas non plus besoin de faire précéder tes Ranges et autres Cells de l'expression Worksheets("Finances"), cette expression est également implicite puisque tu te trouves dans le module de code de cette feuille.
Cordialement,
|
Didier FOURGEOT