Pb VBA

Emiate -
Emiate - 26 mai 2011 à 13:38

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!

Afficher la suite

A voir également:

Pb VBA
Excel compter cellule couleur sans vba - Guide
Incompatibilité de type vba ✓ - Forum VB / VBA
Erreur 13 incompatibilité de type VBA excel ✓ - Forum Excel
Mkdir vba ✓ - Forum VB / VBA
Dépassement de capacité vba ✓ - Forum Excel

9 réponses

Réponse 1 / 9

melanie1324 Messages postés 1504 Date d'inscription Statut Membre Dernière intervention 155

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

melanie1324 Messages postés 1504 Date d'inscription Statut Membre Dernière intervention 155

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

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

Réponse 2 / 9

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!

Réponse 3 / 9

melanie1324 Messages postés 1504 Date d'inscription Statut Membre Dernière intervention 155

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

Réponse 4 / 9

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 = ....

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

Posez votre question

Réponse 5 / 9

melanie1324 Messages postés 1504 Date d'inscription Statut Membre Dernière intervention 155

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

Réponse 6 / 9

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

chossette9 Messages postés 4239 Date d'inscription Statut Contributeur Dernière intervention 1 311

Bonjour,

pour la boucle perpétuelle, ça vient surement du fait que juste après le Do While a<=20 tu avais a=1.

Réponse 7 / 9

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

Réponse 8 / 9

melanie1324 Messages postés 1504 Date d'inscription Statut Membre Dernière intervention 155

donc c'est ok?

Réponse 9 / 9

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!

Discussions similaires

"L'indice n'appartient à la sélection" + VBA

Erreur d'exécution 13 Incompatibilité de type

appliquer une pause dans une macro vba excel

ouverture d'un fichier excel à partir d'un code VBA

Méthode find dans VBA - Recherche de données sous Excel

Votre réponse

Discussions similaires