Pb VBA

Emiate -  
 Emiate -
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!

9 réponses

  1.
    melanie1324 Messages postés 1561 Statut Membre 156
     
    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
    0
    1. melanie1324 Messages postés 1561 Statut Membre 156
       
      il y a une toute petite erreur remplace :
      if sheets("Total").cells(i,3) = z-listefarm then
      par :
      if sheets("Total").cells(i,3) = z_listefarm then
      0
    2. Emiate
       
      en tous cas, je te remercie de l'effort, mais comme je l'explique en bas, j'ai je pense résolu le pb en mettant une condition que j'ai appelé cible
      0
  2. Emiate
     
    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!
    0
  3. melanie1324 Messages postés 1561 Statut Membre 156
     
    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
    0
  4. Emiate
     
    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 = ....
    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. melanie1324 Messages postés 1561 Statut Membre 156
     
    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
    0
  7. Emiate
     
    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!!
    0
    1. chossette9 Messages postés 6855 Date d'inscription   Statut Contributeur Dernière intervention   1 313
       
      Bonjour,

      pour la boucle perpétuelle, ça vient surement du fait que juste après le Do While a<=20 tu avais a=1.
      0
  8. Emiate
     
    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
    0
  9. melanie1324 Messages postés 1561 Statut Membre 156
     
    donc c'est ok?
    0
  10. Emiate
     
    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!
    0

Discussions similaires

erreur d'execution 9, l'indice n'appartient pas à la sélection
isidoh -
isidoh -

18 réponses
VBA excel : résoudre problème de capacité.
Juan Pedro -
Kunzi -

9 réponses
"L'indice n'appartient à la sélection" + VBA
fleur.31 -
geosevda -

2 réponses
Méthode find dans VBA - Recherche de données sous Excel
baissaoui -
baissaoui -

0 réponse
Erreur d'exécution 13 Incompatibilité de type
grace -
pijaku -

5 réponses