Compilation de données

[JMDBOULE78]

Bonjour,

d'ordinaire je passe par un filtre elaboré, ou par un autre feuille de calcul qui m"enleve les 0, pour recompiler par un TCD ou formules mais c'est lourd. Avez vous une solution par une formule qui permette de faire la compilation?
Bon weekend

 

[Tibo]

Re : Compilation de données

Bonjour,

Pas sûr que ce soit moins lourd, une solution avec une formule matricielle :

Onglet Compile, en B3 :

=SI(LIGNES($1:1)>NB.SI(DONNEES!$F$3:$F$100;">0");"";INDIRECT("'DONNEES'!"&ADRESSE(PETITE.VALEUR(SI(DONNEES!$F$3:$F$100<>0;(DONNEES!$F$3:$F$100<>0)*LIGNE($3:$100));LIGNES($1:1));COLONNE())))

Formule matricielle à valider par CTRL + MAJ + ENTREE

à recopier vers le bas et vers la droite

@+

 

[JMDBOULE78]

Re : Compilation de données

Bonjour Tibo, merci cela fonctionne. je vais tester pour checker, car cela fait partie d'un plus gros fichier et je voudrais mesurer l'impact en terme de calcul. Merci en cas, bon weekend @ vous.

 

[ChTi160]

Re : Compilation de données

Bonjour JMDBOULE78
bonjour le Fil
Bonjour Le Forum
un exemple de ce qui est possible en VBa

Option Explicit
Option Base 1
Sub test()
'on declare les variables
Dim TbS() As Variant
Dim TbR() As Variant
Dim L As Byte
Dim x As Byte
'on initialise la variable
x = 1
With Worksheets("DONNEES") ' à partir de cette feuille
 TbS = .Range("B3:F8").Value 'on remplie un tableau des donnees de la plage ainsi definie pour l'exemple
   For L = 1 To UBound(TbS, 1) 'pour chaque ligne de ce tableau
       If TbS(L, 5) <> 0 Then 'si la colonne 5 de ce tableau n'est pas egale à 0
      ReDim Preserve TbR(UBound(TbS, 2), x) 'on redimenssionne le tableau du Résultat TbR
             TbR(1, x) = TbS(L, 1) 'et on colle la donnee correspondant à la premiere colonne
             TbR(2, x) = TbS(L, 2) 'etc
             TbR(3, x) = TbS(L, 3) 'etc
             TbR(4, x) = TbS(L, 4)
             TbR(5, x) = TbS(L, 5)
                 x = x + 1   'on incremente
       End If 'fin de condition
   Next L 'autre ligne du tableau Source TbS
End With
With Worksheets("COMPILE") 'avec cette feuille

'ci dessous on colle les donnees recueillies en Colonne en l'inversant
  .Range("B3").Resize(UBound(TbR, 2), UBound(TbR, 1)) = Application.Transpose(TbR)

End With
End Sub

Le fichier : Regarde la pièce jointe Compile test.xls
Bonne journée
Amicalement
Jean Marie

 

[mapomme]

Re : Compilation de données

Bonjour JMDBOULE78,

Un autre essai. La feuille Compile se met à jour quand les données de la feuille Donnees sont modifiées.

Code du module de feuille "DONNEES":

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Range("B:F"), Target) Is Nothing Then Exit Sub
If Worksheets("DONNEES").FilterMode Then Cells.AutoFilter
Range(Cells(2, "b"), Cells(Rows.Count, "b").End(xlUp).Offset(, 4)).AutoFilter Field:=5, Criteria1:="<>0"
Range(Cells(2, "b"), Cells(Rows.Count, "f").End(xlUp)).SpecialCells(xlCellTypeVisible).Copy _
    Destination:=Sheets("COMPILE").Range("B2")
If Worksheets("DONNEES").FilterMode Then Cells.AutoFilter
End Sub

 

[ChTi160]

Re : Compilation de données

Re JMDBOULE78,
Salut mapomme

je ne sais pas , mais j'apprends a utiliser ces fameux Filtres dans les procédures vba lol
ci dessous ma macro modifiée

Option Explicit
Option Base 1
Sub test()
'on declare les variables
Dim TbS As Variant
Dim TbR() As Variant
Dim L As Byte
Dim x As Byte
Dim C As Byte
'on initialise la variable x
x = 1
With Worksheets("DONNEES") ' à partir de cette feuille
 TbS = .Range("B3:F8").Value 'on remplie un tableau des donnees de la plage ainsi definie pour l'exemple
   For L = 1 To UBound(TbS, 1) 'pour chaque lignes de ce tableau
       If TbS(L, 5) <> 0 Then 'si la colonne 5 de ce tableau n'est pas egale à 0
      ReDim Preserve TbR(UBound(TbS, 2), x) 'on redimenssionne le tableau des Résultats TbR
            For C = 1 To UBound(TbS, 2)
              TbR(C, x) = TbS(L, C) 'et on colle ici les donnees de chaque colonnes
            Next C
                 x = x + 1   'on incremente
       End If 'fin de condition
   Next L 'autre ligne du tableau Source TbS
End With
With Worksheets("COMPILE") 'avec cette feuille

'ci dessous on colle les donnees recueillies en Colonne en l'inversant
  .Range("B3").Resize(UBound(TbR, 2), UBound(TbR, 1)) = Application.Transpose(TbR)

End With
End Sub

Bonne journée
Amicalement
Jean Marie