Macro de filtre élaborée avec lignes variable et moyennes

Xhishounyu

XLDnaute Nouveau
Bonjour à tous!

Je suis débutante en VBA, et là je bloque sur une étape d'une macro. En effet, je ne sais pas comment lui demander de selectionner quelques choses une ligne en dessous de tel tableau (donc à la premiére ligne vide), ni de créer une liste de formules dans la 3eme ligne vide par exemple sans nommer la ligne.

Bon traduction:
Sachant que le tableau a des lignes variables (mais des colonnes fixes et les cellules de la premiére colonnes sont toujours pleines), est-il possible de faire une macro créant la zone de critére une ligne en dessous du tableau, créant ensuite le filtre élaboré et le copier une ligne en dessous de la zone de critére. Enfin, créer une ligne avec les moyennes de chaque colonnes.
Je viens de me rappeller quelques chose d'important: les lignes ne sont pas vide au sens propre, mais elles contiennent des formules qui n'affichent rien.


Merci de votre aide:)

Voici un exemple:
 

Pièces jointes

  • Exemple.xls
    15 KB · Affichages: 42
  • Exemple.xls
    15 KB · Affichages: 41
  • Exemple.xls
    15 KB · Affichages: 43
Dernière édition:

PMO2

XLDnaute Accro
Re : Macro de filtre élaborée avec lignes variable et moyennes

Bonjour,

Une piste avec le code suivant

Code:
'### Constantes à adapter ###
Const FIRST_CELL_DATA As String = "A1"
Const FIRST_CELL_CRITERE As String = "M1"
'############################

Sub FitreElaboreMoyennes()
Dim S As Worksheet
Dim R As Range
Dim R2 As Range
Dim Lig&
Dim nbCol&
Dim i&
Dim A$
On Error GoTo Erreur

ActiveSheet.Copy After:=Sheets(ActiveSheet.Index)
Set S = ActiveSheet
Set R = S.Range(FIRST_CELL_DATA).CurrentRegion
nbCol& = R.Columns.Count
Set R2 = S.Range(FIRST_CELL_CRITERE).CurrentRegion
Lig& = R.Rows.Count + 1
R2.Copy Destination:=R.Offset(Lig&, 0)
Application.CutCopyMode = False
Lig& = Lig& + R2.Rows.Count + 1
R.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=R2, _
    CopyToRange:=R.Offset(Lig&, 0), Unique:=False
Set R = S.Range(FIRST_CELL_DATA).Offset(Lig&, 0).CurrentRegion
Set R = R.Offset(1, 0).Resize(R.Rows.Count - 1, 1)
For i& = 2 To nbCol&
  Set R = R.Offset(0, 1)
  Set R2 = R.Offset(3, 0).Resize(1, 1)
  R2.Formula = "=AVERAGE(" & R.Address(False, False) & ")"
Next i&
Erreur:
If Err <> 0 Then
  Application.DisplayAlerts = False
  If Not S Is Nothing Then S.Delete
  Application.DisplayAlerts = True
  A$ = "Erreur " & Err.Number & vbCrLf & Err.Description
  If Err = 1004 Then
    A$ = A$ & vbCrLf & vbCrLf & "La 1ère cellule des données doit être " & FIRST_CELL_DATA & _
      vbCrLf & "La 1ère cellule des critères doit être " & FIRST_CELL_CRITERE
  End If
  MsgBox A$
End If
End Sub


Les données doivent commencées en A1 et les critères en M1 (ou adaptez à votre usage les constantes cernées par des ###)

Plutôt que de m'étendre en explications, essayez l'exemple de la pièce jointe en ayant sélectionné la feuille "test" avant de lancer la macro.

Cordialement.

PMO
Patrick Morange
 

Discussions similaires

Statistiques des forums

Discussions
312 329
Messages
2 087 327
Membres
103 518
dernier inscrit
hbenaoun63