MACRO POUR MOYENNER DE MANIERE SIMPLE UNE BASE DE DONNEES

Résolu

SERIEUXETCOOL Messages postés 336 Date d'inscription dimanche 3 avril 2011 Statut Membre Dernière intervention 12 juin 2012 - 1 août 2011 à 20:00
ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 - 28 sept. 2011 à 09:59

(Dsl si je ne post pas au bon endroit, merci de déplacer)

Bonjour,

Je dispose d'un code sous VBA qui permet de me faire tourner une petite marco sous Excel. Ce code permet de supprimer certaines lignes présentes dans une base de données déjà existante.

Maintenant je cherche poursuivre le développement de cette macro en réalisant 2 fonctions supplémentaires.

-La première fonction est de faire une moyenne sur un ensemble particulier de lignes. Ces lignes vont varier de position suivant la base de données. Et elle ne seront pas au même nombre à chaque fois.

-La dernière fonction étant de remplacer les lignes qui auront servi à calculer les moyennes pas la valeur moyennée justement. Donc on fait une suppression de lignes et un remplacement de valeurs.

Je ne sais pas si je suis clair, de toute façon d'autres explications vont suivre si-après, plus le code pour voir mieux un petit exemple.

Voici le code existant qui permet de créer une petite base de données à titre d'exemple et de supprimer certaines lignes :
(elle fonctionne très bien)

Sub Macro1()
  Cells.Clear ' Vide la feuille

  Dim plage As Range, plage_a_supp As Range
  Dim nb As Long, n As Long, i As Long, j As Long, msg As String
  Dim t, ii As Byte

  t = Split("1 11 21 31") 'Permet de créer une petite table pour exemple
  For ii = 0 To 3
     Cells(t(ii), 1).Resize(10) = ii
     Cells(t(ii), 2).Resize(10) = [=TRANSPOSE({1,2,3,4,5,6,7,8,9,10})]
  Next ii
  n = ActiveSheet.UsedRange.Rows.Count 'Compte le nombre de lignes dynamiques
  nb = 4 'pour ôter 4 lignes en bas et 4 en haut
   If nb = 0 Then Exit Sub
   msg = ""
   For i = 2 To n + 1
     If Range("A" & i).Value = Range("A" & i - 1).Value Then
       If plage Is Nothing Then
         Set plage = Union(Range("A" & i - 1), Range("A" & i))
       Else
         Set plage = Union(plage, Range("A" & i))
       End If
     Else
       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("A" & i)
         If Range("A" & i).Value = "" Then Exit For
       Else
         msg = msg & " - " & plage(1, 1).Value
         Set plage = Nothing
         If Range("A" & i).Value = "" Then Exit For
       End If
     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

Ce qu'il reste à faire...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 connu mais variable. C'est une série de nombre entier, ordonnée du plus petit au plus grand.
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

Pour ce faire, il faut bien sur réutiliser le même code précédent. Une première partie du code supprime un certains nombre de lignes et la deuxième partie du code doit pouvoir me calculer la moyenne sur chaque série d'entier naturel et l'afficher pour remplacer la série d'entier.

Je pense être clair mais si vous avez besoin de plus d'infos je suis la.

Merci pour votre aide.

PS : J'ai commencé en utilisant la fonction suivante qui fonctionne. Mais je ne parviens pas à l'intégrer dans une boucle.

Formule = Application.Average(Range("A" & i, ":A" & j))

A voir également:

MACRO POUR MOYENNER DE MANIERE SIMPLE UNE BASE DE DONNEES
Base de données javascript - Conseils pratiques -Javascript
Récupérer données json (javascript) - Conseils pratiques -Javascript
Nomenclature base de données - Conseils pratiques -PHP
Connexion base de données - Conseils pratiques -PHP
Connecter une application android à une base de données - Conseils pratiques -Java

90 réponses

Réponse 81 / 90

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
26 sept. 2011 à 22:15

1) As-tu lu mon dernier message à propos de l'écrêtement de 0 lignes ?
2) non, on ne peut faire des différences sur les heures comme on les fait en base 10

3) l'erreur (en effet) sur les moyennes a la même raison que celle qui existait pour les colonnes à différence ==>> nous étions partis au départ sur l'existence de plusieurs colonnes de ce type et là, tu n'en a qu'une (la C)
La correction à faire est strictement la même que celle que nous avions apportée pour les colonnes de différence, à savoir :

If UBound(moy) > 0 Then

à transformer en

If moy(0) <> "" Then

Voilà tout .

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

Réponse 82 / 90

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
26 sept. 2011 à 22:42

non, on ne peut faire des différences sur les heures comme on les fait en base 10

Pour que tu comprennes mon insistance :
10 h 40 - 10 h 30, si tu les "transformes" (comme tu dis) en 10,40-10,30 ===>> 0,10 certes !
mais 11 h 10 - 10 h 40 ne te donnes certes pas 11,10-10,40, soit 0,70 ==>> mais 30 minutes = 0,5 heures

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

Réponse 83 / 90

SERIEUXETCOOL Messages postés 336 Date d'inscription dimanche 3 avril 2011 Statut Membre Dernière intervention 12 juin 2012 1
26 sept. 2011 à 23:13

Merci pour la correction concernant les moyennes. Sa marche la encore beaucoup mieux^^

Remarque : Faut-il supprimer cette ligne

  If UBound(cols) = 0 Then Exit Function

qui se trouve ici

Public Function verif(cols, colonne_groupes, a_partir_ligne, descr As String) As Boolean
  
  Dim derLig As Long
  Dim plage As Range
  Dim elmt As Variant
  
  verif = True
  If UBound(cols) = 0 Then Exit Function

ou pas du tout ?

En tout cas j'ai rapidement vérifié que le code fonctionnait si l'on avait plusieurs colonnes de moyennes (c'est mon cas !!!) et sa semble bien fonctionner. Ça c'est cool.

-Je me permets d’insister de nouveau à mon tour sur le fait de faire des différences entre les heures. Ce n'est pas pour t'embêter Ucfoutu, mais vraiment c'est utile au problème. Et sa nous fait avancer.

Je suis d'accord avec toi sur l'exemple que tu donnes. C'est justement ce que j’essayais de te dire dans mon post ou j’abordais cette problématique. On ne peut pas TOUT faire avec les heures. Pour éviter ce genres d'erreurs, c'est pour quoi j'ai volontairement décidé d'utiliser la plage [16H00;16H59]. Ainsi la fonction différence est très bien adaptée.

Et d'ailleurs, il n'en reste pas moins que la fonction différence ne fonctionne toujours pas !

Appliquée à l'exemple des poissons, ton code me propose la réponse suivante

Groupe 0 : 0,40 Min (Prise en compte du zéro aboslu, le premier groupe est parfait)
Groupe 1 : 16,19 Min (Mais la franchement, c'est quoi cette valeur ???)

La bonne réponse est la suivante :

Groupe 0 : 16,45 - 16,05 = 0,40 Min (Ok avec ton code)
Groupe 1 : 16,59 - 16,45 = 0,14 Min (ou est le loup ???)

Fixons premièrement ces problèmes la, et ensuite j'aborderais d'autres remarques pour ne pas tout mélanger et rester efficace.

Je ne vois pas l'erreur que j'ai pu faire...

André

Réponse 84 / 90

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
27 sept. 2011 à 08:22

Groupe 0 : 16,45 - 16,05 = 0,40 Min (Ok avec ton code)
Groupe 1 : 16,59 - 16,45 = 0,14 Min (ou est le loup ???)

T'as dû rater quelque chose car j'ai bien ces résultats (les deux) chez moi !

If UBound(cols) = 0 Then Exit Function

ne sert plus vraiment, maintenant, mais remplace-là par

If cols(0) = "" Then Exit Function

juste pour le cas où tu déciderais de ne plus avoir du tout de colonne de "différences"

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

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

Posez votre question

Réponse 85 / 90

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
27 sept. 2011 à 08:39

1) j'insiste : j'ai bien ces résu_ltats chez moi et tu a dû rater quelque-chose.
2) ceci m'inquiète :

Je suis d'accord avec toi sur l'exemple que tu donnes. C'est justement ce que j’essayais de te dire dans mon post ou j’abordais cette problématique. On ne peut pas TOUT faire avec les heures. Pour éviter ce genres d'erreurs, c'est pour quoi j'ai volontairement décidé d'utiliser la plage [16H00;16H59]. Ainsi la fonction différence est très bien adaptée.

Que veux-tu dire ? Veux-tu dire que, dans ton outil, ce ne seront pas des valeurs numériques, en fait, mais des heures ?
Cette précision est très importante ! Si ce sont des heures et non des nombres décimaux :
a) il me faudra modifier des calculs (ils ne se font pas du tout de la même manière)
b) tu devras, de ton côté, inclure la date (champs de type jj/mm/aaaa hh:mm:ss) car j'ai en mémoire ceci, que tu as écrit Dimanche :

Un essai peut durer 10 min, 1 heure, 1 jour etc...

Si tu veux que ton outil soit vraiment efficace, ce sont ces dates/heures précises, qu'il te faut relever directement, plutôt que de passer curieusement par un "compteur qui s'incrémente" !
____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

Réponse 86 / 90

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
27 sept. 2011 à 11:43

Ah Ah !
Je viens de tomber dessus (quand on modifie la variable depart) :

On recalculait deb par rapport à ce qui avait- déjà été modifié !
J'ai du coup utilisé une variable tremplin que j'ai appelée ahah (de circonstance)

Voilà :

Public Sub epurer(ByVal col As String, ByVal ligne As Integer, ByVal nb As Integer, ByVal col_tremplin As Integer, ByVal dif, ByVal deb As Single)
  Dim plage As Range, plage_a_supp As Range, ahah As Single
  Dim n As Long, i As Long, j As Long, msg As String
   n = Range(col & Rows.Count).End(xlUp).Row
   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
          Dim R As Range
          If dif(0) <> "" Then
            For Each R In plage.Rows
              ahah = Cells(plage.Row + plage.Rows.Count - 1, 2).Value
              Cells(R.Row, dif(0)).Value = ahah - deb
            Next
          End If
          If dif(0) <> "" Then deb = ahah
         If plage.Rows.Count > (nb * 2) + 1 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

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

Réponse 87 / 90

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
27 sept. 2011 à 12:48

Voilà.
Je pense que nous y sommes maintenant totalement.
Procède à tes vérifications.
Si confirmé ===>> il me faudra :
1) faire un petit ménage (nous n'avons plus de colonne tremplin)
12) passer en "souple" une ligne qui est encore en "dur" (un 2 qui fige sur la colonne B au lieu d'un x correspondant à la colonne des différences). Mais cela est super-facile et déjà fait, entre-temps.

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

Réponse 88 / 90

SERIEUXETCOOL Messages postés 336 Date d'inscription dimanche 3 avril 2011 Statut Membre Dernière intervention 12 juin 2012 1
27 sept. 2011 à 14:42

Coucou me revoilà. Dsl pour le retard, mais je suis au boulot et je suis un peu débordé la. Pas facile de tout gérer.

Donc comme je suis au boulot, je n'ai peux pas poursuivre tous les tests que je voudrais faire. Mais j'ai tout de même pu tester en priorité les modifications que tu me propose.

Ah ah !!!! Sa marche VRAIMENT mieux maintenant. Youhouhou on y arrive. Prise en compte du zéro absolu efficace, calcul des différences ok, calcul des moyennes ok, réduction des groupes ok, suppression des lignes ok. Sa fait pas mal de choses bonnes la.

Continuons ainsi...

J'ai de mon côté une bonne nouvelle qui va te rassurer, dans mon application personnelle, je n'utilise pas des heures. Mais simplement des secondes. J'ai un "chronomètre" qui se déclenche TOUJOURS de zéro et qui compte en s'incrémentant. Si l’essai dure 20 min, on s'en fiche aussi. Nous on aura simplement la vision des secondes écoulées et rien de plus. Donc sois rassuré, ma valeur d'incrémentation est belle et bien une valeur numérique et ton code fonctionne dans ces conditions.

Les heures c'était juste pour ton exemple de poissons, rien de plus. Moi j'ai des secondes qui partent de 0 et qui s'incrémentent tant que l'essai n'ai pas finit. 10 secondes, 1 000 secondes, etc... On s'en fiche. Sa reste une valeur numérique en base 10.

Donc pas de changements de programmation dans ton code de calcul Ucfoutu^^ (ouffff)

Je terminerais les vérifications ce soir à mon retour à la maison. Je testerais tout ce que je peux. Et te dirais si ton code reste infaillible ou pas.

Procède à tes vérifications.
Si confirmé ===>> il me faudra :
1) faire un petit ménage (nous n'avons plus de colonne tremplin)
12) passer en "souple" une ligne qui est encore en "dur" (un 2 qui fige sur la colonne B au lieu d'un x correspondant à la colonne des différences). Mais cela est super-facile et déjà fait, entre-temps.

Je te laisse "nettoyer" ton code à ta façon^^. Tu sais mieux que moi ce que tu fait. En tout cas, je pense que tu peux commencer à le lustrer ce petit bout de code ! Il fait de bien belles choses mine deux ;)

Salutations

Ps : De mémoire (donc je ne suis pas sur de ce que j'avance), il me semble qu'hier soir lorsque que je faisais supprimer un certains nombre de lignes de manière à ce qu'il ne reste plus que 2 lignes dans un groupe quelconque alors j'avais un message d'alerte m'avertissant que ce fameux groupe ne serait pas touché par la surpression. Or maintenant on sais que pour que tous les calculs fonctionnent, la condition nécessaire est d'avoir au moins une ligne par groupe après épurement.
Tant que le groupe possède une ligne alors on peut faire la différence et la moyenne. Par contre si l'on supprime autant de lignes que n'en compte le groupe alors dans ce cas la, on aura le message d'alerte nous indiquant que le groupe ne sera pas touché par la surpression. En effet on ne peut pas supprimer un groupe entièrement !!!

Bilan, peut tu faire en sorte que lorsqu'un groupe se retrouve avec 0 lignes après suppression et bien que le message d'alerte apparaisse, et que l'on ne traite pas ce groupe en terme de suppression de lignes ? Sa serait cool

Je récapépète :
-Si le groupe contient 0 ligne après suppression, alors message d'alerte et on ne supprime pas les lignes de ce groupe.
-Si le groupe contient 1 ligne après suppression, alors pas de message d'alerte et on supprime les lignes de ce groupe.
-Si le groupe contient 2 lignes après suppression, alors pas de message d'alerte et on supprime les lignes de ce groupe.
-Si le groupe contient 3 lignes après suppression, alors pas de message d'alerte et on supprime les lignes de ce groupe.
Et ainsi de suite...

Réponse 89 / 90

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
27 sept. 2011 à 17:01

Alors voilà, après nettoyage et tes "récapépètess"

Tu noteras que j'ai ajouté une variable : la variable Minimum_devant_rester. Elle te permet, plus souplement, de décider comme tu l'entends. Je l'ai mise ici à 1. Elle peut prendre toute valeur positive, à condition qu'elle soit > 0, bien évidemment

Option Explicit
Sub DIFFERENCE_SUPPRESSION_MOYENNE()

''''''   tout ton début de reconstruction
''''''
'''''' 
    
    Dim colonne_groupes As String, a_partir_ligne As Integer, ecreter_de_combien As Long, Minimum_devant_rester As Integer
    Dim depart As Single
    Dim col_groupes As Variant, colonnes_moyennes As Variant, colonnes_diff As Variant
  
  ' ==============================c'est ici que tu définis la feuille des données ==========================================
  feuille_donnees = "MACRO" ' <<<<<========= 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 = 2 '<<<<<<============ ici : la ligne où commencent les groupes
  ecreter_de_combien = 2 '<<<<======= ici : de combien écréter en haut et en bas de chaque groupe
  
  Minimum_devant_rester = 1 '<<<<======= ici : écrêtement si ce minimum après écrêtement sinon non
  depart = 0 ' <<<<<===== ligne rajoutée ici (et la valeur de ton choix, sous forme avec . comme séparateur décimal si utilisé, hein ...)
  
  colonnes_moyennes = Array("C") '<<<<=== ici : énumération des colonnes où faire la moyenne ("") si aucune
  colonnes_diff = Array("B") ' <<<<<===== ici : la SEULE  colonne où faire ta "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, Minimum_devant_rester, colonnes_diff, depart


  ' ----------------------------------------puis en traitant le reste (écart(s) et moyenne(s) ---------------------------
   MsgBox "On vient d'épurer"
    on_amenage colonne_groupes, a_partir_ligne, colonnes_moyennes, colonnes_diff
    ActiveSheet.Buttons.Add(440, 15, 120, 45).Select
    Selection.OnAction = "BASE_DE_DONNEES_FINALE"
    Selection.Characters.Text = "BASE DE DONNEES INNITIALE"
    ActiveSheet.Buttons.Add(600, 15, 120, 45).Select
    Selection.OnAction = "DIFFERENCE_SUPPRESSION_MOYENNE"
    Selection.Characters.Text = "BASE DE DONNEES FINALE"
End Sub
Public Sub epurer(ByVal col As String, ByVal ligne As Integer, ByVal nb As Integer, ByVal mini As Integer, ByVal dif, ByVal deb As Single)
  Dim plage As Range, plage_a_supp As Range, ahah As Single
  Dim n As Long, i As Long, j As Long, msg As String
   n = Range(col & Rows.Count).End(xlUp).Row
   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
          Dim R As Range
          If dif(0) <> "" Then
            For Each R In plage.Rows
               ahah = Cells(plage.Row + plage.Rows.Count - 1, dif(0)).Value
              Cells(R.Row, dif(0)).Value = ahah - deb
            Next
          End If
          If dif(0) <> "" Then deb = ahah
         If plage.Rows.Count > (nb * 2) + mini - 1 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
       'MsgBox plage.Address
       If combien > 1 Then
         If moy(0) <> "" Then
           For Each elmt In moy
             'MsgBox k
             k = Range(elmt & ":" & elmt).Column - deb + 1
             
             plage.Cells(1, k) = WorksheetFunction.Average(plage.Columns(k))
             'MsgBox plage.Columns(k).Address
           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
  Dim derLig As Long
  Dim plage As Range
  Dim elmt As Variant
  verif = True
  If cols(0) = "" Then Exit Function
  derLig = Range(colonne_groupes & Rows.Count).End(xlUp).Row
  For Each elmt In cols
    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 Function

Réponse 90 / 90

ucfoutu Messages postés 18038 Date d'inscription lundi 7 décembre 2009 Statut Modérateur Dernière intervention 11 avril 2018 211
28 sept. 2011 à 09:59

Oui, André : ce sujet est terminé.
Toutefois : si j'avais connu dès le départ les tenants et aboutissants exacts (tels que précisés ensuite au fur et à mesure), j'aurais probablement "codé" de manière différente.
Je vais le faire cette semaine, juste par goût personnel. Si concluant (comme je le pense intimement) ===>> je t'enverrai un code totalement différent par messagerie privée, pour ne pas alourdir plus la présente discussion.

____________________
Réponse exacte ? => "REPONSE ACCEPTEE" pour faciliter les recherches d'autres forumeurs.
Pas d'aide en ligne installée ? ==> ne comptez pas sur moi pour simplement vous dire ce qu'elle contient

Discussions similaires

Prob de Restauration base de données

conception base de données e-commerce

Base de données voitures Marques et Modeles

restaurer une base à partir d'un fichier bak

Comment réaliser une sauvegarde de base MS SQL via un raccourci sur le bureau

Votre réponse

Discussions similaires