SERIEUXETCOOL
XLDnaute Occasionnel
Bonjour le Forum,
Je dispose d'un code VBA qui fonctionne très bien sous Excel 2007. Le souci, c'est que je suis débutant sous Excel et que ce code a été créé par une autre personne. J'ai une petite modification du code à faire...mais je n'y parviens pas seul.
Je compte donc sur l'aide d'un utilisateur "assez expérimenté" pour m'aider à modifier simplement ce code.
Voici le code en question :
Ce code permet de supprimer un certain nombre de lignes, d'en faire la moyenne et aussi de faire une différence.
De manière générale j'ai une feuille Excel avec les données suivantes :
Colonne1/Colonne2/Colonne3...
0 xxx xxx
0 xxx xxx
0 xxx xxx
1 xxx xxx
1 xxx xxx
1 xxx xxx
2 xxx xxx
2 xxx xxx
2 xxx xxx
3 xxx xxx
3 xxx xxx
3 xxx xxx
-Les données partent de 0 et vont jusqu'à X. X étant un nombre entier connu mais variable. C'est une série de nombre entier, ordonnée du plus petit au plus grand et commençant par 0.
Chaque entier naturel est répété un certain nombre de fois. Dans mon exemple on compte de 0 à 3 en répétant chaque chiffre 3 fois. (c'est un exemple)
-Mon but est de calculer la moyenne sur certaines colonnes de la manière suivante. Je commence avec la première série de 0. Je fais la moyenne sur toute les lignes qui ont pour indice 0, j'insère une ligne, je note la moyenne et je supprimer toutes les valeurs qui m'on servi à calculer la moyenne. Je fais donc la moyenne pour la colonne A, B,C...
-Ensuite je passe à l'entier naturel suivant, les 1. Et ainsi de suite.
-A la fin je souhaite obtenir un fichier ne représentant que les moyennes
Colonne1/Colonne 2/Colonne3....
0 XXX XXXX
1 XXX XXXX
2 XXX XXXX
3 XXX XXXX
Jusque la le code fonctionne très bien. J'ai testé.
Le problème réside sur la fonction pour faire la différence. C'est à dire que je cherche suivant la colonne voulue, à prendre la dernière valeur moins la première. Et en afficher le résultat.
Sur le code présenté ci-dessus, la fonction de différence est bien codée, mais elle ne fonctionne pas quand on fait un test. Sa fait la moyenne et non la différence. Pourtant c'est codée en tant que différence !!!
Il doit y avoir un petit conflit mais je ne parviens pas à le trouver dans le code.
Je ne sais pas si je suis clair dans ma démarche, je reste dans le coin pour les questions éventuelles. A mon sens il ne s'agit que d'une petite modification du code. Rien de plus.
Merci pour votre aide je galère un peu bcp la^^
Cordialement,
André
Je dispose d'un code VBA qui fonctionne très bien sous Excel 2007. Le souci, c'est que je suis débutant sous Excel et que ce code a été créé par une autre personne. J'ai une petite modification du code à faire...mais je n'y parviens pas seul.
Je compte donc sur l'aide d'un utilisateur "assez expérimenté" pour m'aider à modifier simplement ce code.
Voici le code en question :
Code:
Sub ma_big_macro()
Dim feuille_donnees As String
Dim colonne_groupes As String, a_partir_ligne As Integer, ecreter_de_combien As Long
Dim colonnes_moyennes, colonnes_diff
' ==============================c'est ici que tu définis la feuille des données ==========================================
feuille_donnees = "Feuil1" ' <<<<<========= le nom exact de la feuille contenant les groupes à traiter
'===========================================================================================================================
' ================================c'est ici, que tu définis les autres paramètres =========================================
colonne_groupes = "A" '<<<<<<<======== ici : la colonne des groupes
a_partir_ligne = 1 '<<<<<<============ ici : la ligne où commencent les groupes
ecreter_de_combien = 4 '<<<<======= ici : de combien écréter en haut et en bas de chaque groupe
colonnes_moyennes = Array("B", "D", "E", "F") '<<<<=== ici : énumération des colonnes où faire la moyenne ("") si aucune
colonnes_diff = Array("C") ' <<<<<===== ici : énumération des colonnes où faire tes "différences" ("") si aucune
col_groupes = Array(colonne_groupes) ' ---->> ça, c'est pour le code. Ne t'en préoccupe pas.
'==========================================================================================================================
' ________________________________________ les gardes-fou, maintenant ________________________________________________
If ActiveSheet.Name <> feuille_donnees Then
MsgBox "cette opération ne doit être lancée que si la feuille " & feuille_donnees & " est la feuille active"
Exit Sub
End If
If verif(col_groupes, colonne_groupes, a_partir_ligne, "colonne des groupes") = False Then Exit Sub
If verif(colonnes_moyennes, colonne_groupes, a_partir_ligne, "colonne à moyenne") = False Then Exit Sub
If verif(colonnes_diff, colonne_groupes, a_partir_ligne, "colonne à différence") = False Then Exit Sub
'______________________________________________________________________________________________________________________
' ------------------------------ si l'exécution atteint ce point, c'est que tout est cohérent -------------------------
' ------------------------------ on y va donc -------------------------------------------------------------------------
' ---------------------------------------------"écrétant" d'abord------------------------------------------------------
epurer colonne_groupes, a_partir_ligne, ecreter_de_combien
' ----------------------------------------puis en traitant le reste (écart(s) et moyenne(s) ---------------------------
on_amenage colonne_groupes, a_partir_ligne, colonnes_moyennes, colonnes_diff
End Sub
Public Sub epurer(ByVal col As String, ByVal ligne As Integer, ByVal nb As Integer)
Dim plage As Range, plage_a_supp As Range
Dim n As Long, i As Long, j As Long, msg As String
n = Range(col & Rows.Count).End(xlUp).Row
If nb = 0 Then Exit Sub
msg = ""
For i = ligne + 1 To n + 1
If Range(col & i).Value = Range(col & i - 1).Value Then
If plage Is Nothing Then
Set plage = Union(Range(col & i - 1), Range(col & i))
Else
Set plage = Union(plage, Range(col & i))
End If
ElseIf Not plage Is Nothing Then
If plage.Rows.Count >= nb * 2 Then
For j = 1 To nb
If plage_a_supp Is Nothing Then
Set plage_a_supp = Union(plage(1, 1), plage(plage.Rows.Count, 1))
Else
Set plage_a_supp = Union(plage_a_supp, plage(j, 1), plage(plage.Rows.Count + 1 - j, 1))
End If
Next
Set plage = Range(col & i)
If Range(col & i).Value = "" Then Exit For
Else
msg = msg & " - " & plage(1, 1).Value
Set plage = Nothing
If Range(col & i).Value = "" Then Exit For
End If
Else
msg = msg & " - " & Cells(i - 1, 1).Value
End If
Next
If Not plage_a_supp Is Nothing Then
plage_a_supp.Rows.EntireRow.Delete
End If
If msg <> "" Then
MsgBox "les groupes suivants, d'un nombre non suffisant, " & _
"n'ont pas été traités " & vbCrLf & Mid(msg, 3)
End If
End Sub
Public Sub on_amenage(ByVal col As String, ByVal ld As Integer, ByVal moy, ByVal dif)
Dim deb As Long, n As Long, i As Long, combien As Long, k As Long, j As Long
Dim plage As Range, plage_a_supp As Range
Dim elmt
deb = Range(col & ":" & col).Column
n = Range(col & Rows.Count).End(xlUp).Row
For i = ld + 1 To n + 1
If Range(col & i).Value = Range(col & i - 1).Value Then
If plage Is Nothing Then
Set plage = Union(Range(col & i - 1), Range(col & i))
Else
Set plage = Union(plage, Range(col & i))
End If
Else
If Not plage Is Nothing Then
combien = plage.Rows.Count
If combien > 1 Then
If UBound(moy) > 0 Then
For Each elmt In moy
k = Range(elmt & ":" & elmt).Column - deb + 1
plage.Cells(1, k) = WorksheetFunction.Average(plage.Columns(k))
Next
End If
If UBound(dif) > 0 Then
For Each elmt In dif
k = Range(elmt & ":" & elmt).Column - deb + 1
plage.Cells(1, k).Value = plage(plage.Rows.Count, k).Value - plage(1, k).Value
Next
End If
For j = 2 To combien
If plage_a_supp Is Nothing Then
Set plage_a_supp = plage(j, 1)
Else
Set plage_a_supp = Union(plage_a_supp, plage(j, 1))
End If
Next
End If
Set plage = Nothing
End If
End If
Next
If Not plage_a_supp Is Nothing Then
plage_a_supp.Rows.EntireRow.Delete
End If
End Sub
Public Function verif(cols, colonne_groupes, a_partir_ligne, descr As String) As Boolean
verif = True
If UBound(cols) = 0 Then Exit Function
derlig = Range(colonne_groupes & Rows.Count).End(xlUp).Row
For Each elmt In cols
Dim plage As Range
Set plage = Nothing
On Error Resume Next
Set plage = Range(elmt & a_partir_ligne & ":" & elmt & derlig).SpecialCells(xlCellTypeBlanks)
If Not plage Is Nothing Then
MsgBox "la " & descr & " " & elmt & " contient une cellule vide - Corrigez puis relancez, s'il vous plait !"
verif = False
On Error GoTo 0
End If
Next
End FunctionCe code permet de supprimer un certain nombre de lignes, d'en faire la moyenne et aussi de faire une différence.
De manière générale j'ai une feuille Excel avec les données suivantes :
Colonne1/Colonne2/Colonne3...
0 xxx xxx
0 xxx xxx
0 xxx xxx
1 xxx xxx
1 xxx xxx
1 xxx xxx
2 xxx xxx
2 xxx xxx
2 xxx xxx
3 xxx xxx
3 xxx xxx
3 xxx xxx
-Les données partent de 0 et vont jusqu'à X. X étant un nombre entier connu mais variable. C'est une série de nombre entier, ordonnée du plus petit au plus grand et commençant par 0.
Chaque entier naturel est répété un certain nombre de fois. Dans mon exemple on compte de 0 à 3 en répétant chaque chiffre 3 fois. (c'est un exemple)
-Mon but est de calculer la moyenne sur certaines colonnes de la manière suivante. Je commence avec la première série de 0. Je fais la moyenne sur toute les lignes qui ont pour indice 0, j'insère une ligne, je note la moyenne et je supprimer toutes les valeurs qui m'on servi à calculer la moyenne. Je fais donc la moyenne pour la colonne A, B,C...
-Ensuite je passe à l'entier naturel suivant, les 1. Et ainsi de suite.
-A la fin je souhaite obtenir un fichier ne représentant que les moyennes
Colonne1/Colonne 2/Colonne3....
0 XXX XXXX
1 XXX XXXX
2 XXX XXXX
3 XXX XXXX
Jusque la le code fonctionne très bien. J'ai testé.
Le problème réside sur la fonction pour faire la différence. C'est à dire que je cherche suivant la colonne voulue, à prendre la dernière valeur moins la première. Et en afficher le résultat.
Sur le code présenté ci-dessus, la fonction de différence est bien codée, mais elle ne fonctionne pas quand on fait un test. Sa fait la moyenne et non la différence. Pourtant c'est codée en tant que différence !!!
Il doit y avoir un petit conflit mais je ne parviens pas à le trouver dans le code.
Je ne sais pas si je suis clair dans ma démarche, je reste dans le coin pour les questions éventuelles. A mon sens il ne s'agit que d'une petite modification du code. Rien de plus.
Merci pour votre aide je galère un peu bcp la^^
Cordialement,
André
.
