Pb VBA

Question

Bonjour, 

Je suis débutant en vba, et je me suis formé sur le net depuis peu donc désolé pour le code qui doit forcement être tres lourd par rapport à ce qui se fait.
Je suis sur excel 2003 et voici mon pb
Je dispose d'une première feuille avec beaucoup de donnée. Le but final auquel j'aimerais arrivé est de ventiler mes données, donc de les classes par famille de cout. 
Un exemple ci dessous pour plus de compréhension:

Achat MP  j'aimerais que ca me donne Achat MP :
Achat MP                                         Autres :
Frais téléphone
Autres                                            Divers :
Divers

Le tout dans une autre feuille.
Ensuite j'aimerais que pouvoir mettre tout cela dans un tableau récapitulatif du type:

Frais généraux:
                     Achat MP:
                     Divers:

Voici donc le code que j'ai commencé à faire:



 Sub Ventilation()

Dim z_cpt As Long
Dim z_famille As String
Dim z_listefam(20) As String
Dim i As Integer
Dim j As Integer

z_listefam(1) = "Fournitures non stockables-carburants"
z_listefam(2) = "Fournitures administratives et bureau"
z_listefam(3) = "autres matières et fournitures"
z_listefam(4) = "Fournitures Techniques Imprimés papiers"
z_listefam(5) = "Denrees consommables"
z_listefam(6) = "Location Matériel de Transport"
z_listefam(7) = "Documentation générale NDF"
z_listefam(8) = "Documentation technique"
z_listefam(9) = "Dépenses engagées pour réunions"
z_listefam(10) = "Cadeaux clients - 60E"
z_listefam(11) = "Cadeaux clients + 60E"
z_listefam(12) = "frais de deplacement divers"
z_listefam(13) = "Frais de vie repas au réel"
z_listefam(14) = "Frais de déplacement régul forfait repas"
z_listefam(15) = "Frais de vie / soirée étapes"
z_listefam(16) = "Frais de vie Réunions"
z_listefam(17) = "Réceptions"
z_listefam(18) = "Frais de télécommunications"
z_listefam(19) = "Frais téléphone portable"
z_listefam(20) = "Assurances transport"

    Sheets("Total").Select
    Range("c1").Select
    For z_cpt = 1 To UBound(z_listefam)
    z_famille = UCase(z_listefam(z_cpt))
    Sheets("Total").Select
    Range("c1").Select
    
        
    Selection.AutoFilter Field:=3, Criteria1:=z_listefam(z_cpt)
    Selection.CurrentRegion.Select
    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1, Selection.Columns.Count).Select
    Selection.Copy
    Sheets("Retraitement Total").Select
    Range("A1").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(2, 0).Range("A1").Select
    ActiveSheet.Paste
    Range("e1").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Range("a1").Select
             
    Application.CutCopyMode = False
   
    Range("a1").Select
        Sheets("Total").Select
    Range("a1").Select
    
 Next z_cpt
 Selection.AutoFilter
 Sheets("retraitement Total").Select
 Columns("c:c").Select
 Selection.Cut
 Columns("a:a").Select
 Selection.Insert shift:=xlRight
 ActiveWorkbook.Save

End Sub


Le but étant la ventilation des données.
Le pb que je rencontre est que si une de mes données de z_listfam n'existe pas, ca fait des résultats particuliers!
Merci d'avance de votre aide!

melanie1324 · Answer

Bonjour,

Voici ce que je ferais :

Sub Ventilation() 

Dim z_cpt As Long 
Dim z_famille As String 
Dim z_listefam(20) As String 
Dim i As Integer 
Dim j As Integer 

ligne = 2
do while a >=20 
a=1
if a = 1 then
z_listefam = "Fournitures non stockables-carburants" 
else
if a =2 then
z_listefam = "Fournitures administratives et bureau" 
else
if a=3 then
z_listefam = "autres matières et fournitures" 
if a = 4
z_listefam = "Fournitures Techniques Imprimés papiers" 
else
if a = 5 then
z_listefam(5) = "Denrees consommables" 
else
if a = 6 then
z_listefam = "Location Matériel de Transport" 
else
if a = 7 then
z_listefam = "Documentation générale NDF" 
else
if a = 8 then
z_listefam(8) = "Documentation technique" 
else
if a = 9 then
z_listefam = "Dépenses engagées pour réunions" 
else
if a = 10 then
z_listefam = "Cadeaux clients - 60E" 
else
if a = 11 then
z_listefam = "Cadeaux clients + 60E" 
else
if a = 12 then
z_listefam = "frais de deplacement divers" 
else
if a = 13 then
z_listefam = "Frais de vie repas au réel" 
else
if a = 14 then
z_listefam = "Frais de déplacement régul forfait repas" 
else
if a = 15 then
z_listefam = "Frais de vie / soirée étapes" 
else
if a = 16 then
z_listefam = "Frais de vie Réunions" 
else
if a = 17 then
z_listefam = "Réceptions" 
else
if a = 18 then
z_listefam = "Frais de télécommunications" 
else
if a = 19 then
z_listefam = "Frais téléphone portable" 
else
z_listefam = "Assurances transport" 
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if

i= 1
do while sheets("Total").cells(i,3) <>""
if sheets("Total").cells(i,3) = z-listefarm then

sheets("Total").select
rows(i).copy
sheets("retraitement total").select
cells(ligne,1).select
activesheet.paste
ligne = ligne+1
end if
i=i+1
loop
a=a+1
loop

ActiveWorkbook.Save 

End Sub

Emiate · Answer

Je vais essayer cela. 
En fait, j'ai modifié le code et j'ai rajouté :

cible = UCase(z_listefam(z_cpt))
 Selection.AutoFilter Field:=3, Criteria1:=z_listefam(z_cpt)
     Selection.End(xlDown).Select
     Selection.End(xlDown).Select
     Selection.End(xlUp).Select
       If cible = UCase(ActiveCell) Then
    Selection.CurrentRegion.Select

etc etc...

Ca a l'air de fonctionner :)

Ensuite j'ai fait un autre code afin de calculer les résultats pour chaque catégorie, qui semble fonctionner aussi, je le mets ici au cas ou il pourrait servir à quelqu'un : 

Private Sub calcul()
Dim z_cpt As Long
Dim z_famille As String
Dim z_listefam(20) As String
Dim i As Integer
Dim j As Integer
Dim cible As String


z_listefam(1) = "Fournitures non stockables-carburants"
z_listefam(2) = "Fournitures administratives et bureau"
z_listefam(3) = "autres matières et fournitures"
z_listefam(4) = "Fournitures Techniques Imprimés papiers"
z_listefam(5) = "Denrees consommables"
z_listefam(6) = "Location Matériel de Transport"
z_listefam(7) = "Documentation générale NDF"
z_listefam(8) = "Documentation technique"
z_listefam(9) = "Dépenses engagées pour réunions"
z_listefam(10) = "Cadeaux clients - 60E"
z_listefam(11) = "Cadeaux clients + 60E"
z_listefam(12) = "frais de deplacement divers"
z_listefam(13) = "Frais de vie repas au réel"
z_listefam(14) = "Frais de déplacement régul forfait repas"
z_listefam(15) = "Frais de vie / soirée étapes"
z_listefam(16) = "Frais de vie Réunions"
z_listefam(17) = "Réceptions"
z_listefam(18) = "Frais de télécommunications"
z_listefam(19) = "Frais téléphone portable"
z_listefam(20) = "Assurances transport"

    Sheets("Total").Select
    Range("c1").Select
    For z_cpt = 1 To UBound(z_listefam)
    z_famille = UCase(z_listefam(z_cpt))
      cible = UCase(z_listefam(z_cpt))
      
    Sheets("Total").Select
    Range("c1").Select
    Selection.AutoFilter Field:=3, Criteria1:=z_listefam(z_cpt)
    Selection.End(xlDown).Select
     Selection.End(xlDown).Select
     Selection.End(xlUp).Select
      If cible = UCase(ActiveCell) Then
    Selection.CurrentRegion.Select
    Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1, Selection.Columns.Count).Select
    Selection.Copy
    Sheets("Calcul").Select
    Range("A1").Select
   
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(2, 0).Range("A1").Select
    ActiveSheet.Paste
    Range("e1").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Selection.End(xlToRight).Select
    ActiveCell.Offset(1, 0).Range("a1").Select
    Adresse = Range("E5:E65536").End(xlDown).Row
    ActiveCell.FormulaR1C1 = "=SUM(c[-3])"
    

      
Selection.Copy
Sheets("Analyse Frais Détails").Select
Range("b11").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    ActiveCell.Offset(1, 0).Range("a1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
Sheets("calcul").Select
    Range("c1").Select
    Selection.End(xlDown).Select
    Selection.End(xlDown).Select
    Selection.End(xlUp).Select
    Selection.Copy
        Sheets("Analyse Frais Détails").Select
            Range("a1").Select
                Selection.End(xlDown).Select
                Selection.End(xlDown).Select
                Selection.End(xlUp).Select
                ActiveCell.Offset(1, 0).Range("a1").Select
                ActiveSheet.Paste
                Range("a1").Select
                
Sheets("calcul").Select
    Range("E" & Adresse).Select
        Selection.CurrentRegion.Select
        Selection.ClearContents
        Application.CutCopyMode = False
       
            Range("a1").Select
Sheets("Total").Select
    Range("a1").Select
  End If
 Next z_cpt

 
 Selection.AutoFilter
 Sheets("calcul").Select
    Range("E" & Adresse).Select
    Selection.CurrentRegion.Select
    Selection.ClearContents
        Application.CutCopyMode = False
            
Sheets("Analyse Frais Détails").Select
    Range("a1").Select
ActiveWorkbook.Save


End Sub



Encore une fois, il est surement possible de faire quelque chose de moins lourd, mais je le repete, je debute :s

Et la viens mon pb que je n'ai pas réussi à resoudre (je ne sais meme pas si il est possible de faire ce que je veux). 
A savoir, j'aimerais mettre tous ces résultats dans un jolie tableau automatiquement.
Ce que je veux dire, c'est qu'il me fasse la mise en forme du tableau, et qu'il mette les différentes catégories dedans, et que je n'ai plus qu'à mettre un nom pour regrouper chaque catégorie (du type Frais généraux, Frais de personels etc etc). 
Savez vous si cela est possible? et si oui pouvez me mettre sur la voix? 
Merci à tous!

melanie1324 · Answer

Bonjour,

c'est possible, mais il convient alors d'utiliser mon code :

Sub Ventilation()

Dim z_cpt As Long
Dim z_famille As String
Dim z_listefam(20) As String
Dim i As Integer
Dim j As Integer

ligne = 2
do while a >=20
a=1
if a = 1 then
z_listefam = "Fournitures non stockables-carburants"
else
if a =2 then
z_listefam = "Fournitures administratives et bureau"
else
if a=3 then
z_listefam = "autres matières et fournitures"
if a = 4
z_listefam = "Fournitures Techniques Imprimés papiers"
else
if a = 5 then
z_listefam(5) = "Denrees consommables"
else
if a = 6 then
z_listefam = "Location Matériel de Transport"
else
if a = 7 then
z_listefam = "Documentation générale NDF"
else
if a = 8 then
z_listefam(8) = "Documentation technique"
else
if a = 9 then
z_listefam = "Dépenses engagées pour réunions"
else
if a = 10 then
z_listefam = "Cadeaux clients - 60E"
else
if a = 11 then
z_listefam = "Cadeaux clients + 60E"
else
if a = 12 then
z_listefam = "frais de deplacement divers"
else
if a = 13 then
z_listefam = "Frais de vie repas au réel"
else
if a = 14 then
z_listefam = "Frais de déplacement régul forfait repas"
else
if a = 15 then
z_listefam = "Frais de vie / soirée étapes"
else
if a = 16 then
z_listefam = "Frais de vie Réunions"
else
if a = 17 then
z_listefam = "Réceptions"
else
if a = 18 then
z_listefam = "Frais de télécommunications"
else
if a = 19 then
z_listefam = "Frais téléphone portable"
else
z_listefam = "Assurances transport"
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if
end if

i= 1
do while sheets("Total").cells(i,3) <>""
if sheets("Total").cells(i,3) = z-listefarm then

sheets("Total").select
rows(i).copy
sheets("retraitement total").select
cells(ligne,1).select
activesheet.paste
ligne = ligne+1
end if
i=i+1
loop
a=a+1
loop

j=1
do while cells(2,j)<>"" 'permet de compter les colonnes
j=j+1
loop
range(cells(1,1),cells(ligne,j-1)).select 'permet de sélectionner tout le tableau
'ce qui suit est la mise en forme si elle ne te convient, enregistres une macroe t remplace le code
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With

ActiveWorkbook.Save

End Sub

Emiate · Answer

Hello, merci a toi,
J'ai essayé ton code, mais il me bug des le debut sur:
a = 1
if a = 1 then
z_listefam = ....

melanie1324 · Answer

Remplaces

Dim z_cpt As Long
Dim z_famille As String
Dim z_listefam(20) As String
Dim i As Integer
Dim j As Integer


par

Dim z_cpt As Long
Dim z_famille As String
Dim z_listefam as variant
Dim i As Integer
Dim j As Integer


et remplaces :
if a = 4 

par :

if a = 4  then

Emiate · Answer

Alors j'ai essayé ton code, mais il ne fonctionne tjs pas. 
Déjà, au début, il y a :
do while a >= 20
donc le code saute directement la partie suivante,
j'ai essayé de remplacé par a <= 20, ms alors je rentre dans une espèce de boucle perpetuelle que je ne saurais expliquer.
Pour la suite,  il n'aime pas:
Range(Cells(1, 1), Cells(ligne, j - 1)).Select

Mais surtout il ne fait pas ce que je veux :s

le tableau de base que j'ai a plusieurs colonne.
Le critère que je spécifie dans mon code est en colonne c
par la methode du filtre automatique et du copier coller, je peux prendre les données et me les coller dans une autre feuille.
Pour l'instant (et c'est surement que je suis pas tres doué), je ne vois pas ce que me fait ton code :s
Merci de ton implication!! ca m'aide bcp!!

Emiate · Answer

Ah c'est bon pour 
Range(Cells(1, 1), Cells(ligne, j - 1)).Select 

En fait, il y avait j = 1
donc ca renvoyait j = 0
J'ai remplacé par j = 2

melanie1324 · Answer

donc c'est ok?

Emiate · Answer

non toujours pas mais j'ai pas pu travailler sur le code, j'ai deux trois obligations de fin de mois ^^
Je m'y remets d'ici la semaine prochaine je pense
et je posterais des que j'en saurais plus!
Encore une fois merci de ton aide!

Pb VBA

9 réponses

Discussions similaires

Newsletters