Macro pour tirer vers le bas les lignes (MàJ auto)

[shmider]

Bonjour, 🙄

J'aimerai pouvoir au lieu de tirer à chaque fois sur les lignes, automatiser cette manip (avec macro à priori) voir fichier joint s'il vous plaît.

Cepandant, j'ai un second souci et qui est le fait d'éviter de voir les valeurs se repeter i.e: voir colonne I (commandes) equivaut à la colonne M dans le second tableau et colonne H equivaut à la colonne L dans le tableau d'exemple.

Merci.

 

[shmider]

Re : Macro pour tirer vers le bas les lignes (MàJ auto)

Re-Bonjour a toutes et tous,

Est ce que vous avez besoin de plus d'éclaircicements?

Merci.

 

[PMO2]

Re : Macro pour tirer vers le bas les lignes (MàJ auto)

Bonjour,

Une piste en VBA avec des fonctions personnalisées.

Copiez le code ci-dessous dans un module Standard

'### Constantes à adapter ###
Const ROW_BASE As Long = 4  ' 4ème ligne
Const COL_BASE_CUMUL As Long = 6  ' 6ème colonne = "F"
  '°°° La colonne "code F" doit être voisine et précéder la colonne " Q " °°°
Const COL_CODEF As Long = 2 ' 2ème colonne ET inclusion de la 3ème colonne " Q "
'############################

Function CUMUL(Base As Range) As Variant
Dim S As Worksheet
Dim R As Range
Dim C As Range
Dim x#
Application.Volatile
Set S = Sheets(Base.Parent.Name)
Set R = S.Range(S.Cells(ROW_BASE, COL_BASE_CUMUL), _
  S.Cells(Range("a" & ROW_BASE & "").End(xlDown).Row, COL_BASE_CUMUL))
For Each C In R
  If IsNumeric(C) Then x# = x# + C
Next C
If x# <> 0 Then
  CUMUL = x#
Else
CUMUL = vbNullString
End If
End Function

Function NBCOMMANDES(Base As Range) As Variant
Dim S As Worksheet
Dim R As Range
Dim var
Dim i&
Dim j&
Dim T()
Application.Volatile
Set S = Sheets(Base.Parent.Name)
Set R = S.Range(S.Cells(ROW_BASE, COL_CODEF), _
  S.Cells(Range("a" & ROW_BASE & "").End(xlDown).Row, COL_CODEF + 1))
var = R
For i& = 1 To UBound(var, 1)
  If var(i&, 1) = Base Then
    j& = j& + 1
    ReDim Preserve T(1 To j&)
    T(j&) = var(i&, 2)
  End If
Next i&
j& = 0
Do
  If T(UBound(T)) <> "" Then j& = j& + 1
  For i& = UBound(T) - 1 To 1 Step -1
    If T(i&) = T(UBound(T)) Then T(i&) = ""
  Next i&
  If UBound(T) = 1 Then Exit Do
  ReDim Preserve T(1 To UBound(T) - 1)
Loop
NBCOMMANDES = vbNullString
If Base.Row = 1 Then Exit Function
If j& > 0 And Base <> Base.Offset(-1, 0) Then NBCOMMANDES = j&
End Function

Je me suis référé entièrement à votre exemple en feuille "test 1". Il vous faudra peut-être adapter les constantes cernées par des ###.

FONCTION CUMUL
en H4 tapez =cumul(F4)

FONCTION NBCOMMANDES
en I4 tapez =nbcommandes(B4) et tirez la formule jusqu'en I13

Bon courage.

Cordialement.

PMO
Patrick Morange

 

[shmider]

Re : Macro pour tirer vers le bas les lignes (MàJ auto)

Bonjour Patrick,

Je te remerci pour ton aide ainsi que tou les utilisateurs du forum.

Je teste ta proposition en l'adoptant à mon fichier et je te dirai quoi.

Merci encore @+