VBA - tableau et extraction (en fonction de conditions)

Je n'ai pas tenu compte du dernier post

Boisgontier

Boisgontierjacques a écrit :

Je n'ai pas tenu compte du dernier post

Boisgontier

Bonjour M Boisgontier.

Ok, j'ai mis à jour le fichier dans le post précédent.

J'ai mis a jour le fichier ce sera peut être plus simple.

Feuille CATE

j'ai conservé le choix des catégories avec nom en A en numéro en B.

Feuil BD

En appuyant sur le bouton Go caté1 / résultat ça fonctionne parfaitement avec envoi vers RESULTAT1.

En appuyant sur le bouton Go choix caté / résultat2 cela ne fonctionne pas avec envoi vers RESULTAT2 (je n'arrive pas a résoudre).

En appuyant sur Go caté1 / résultat, j’aimerai aussi pouvoir traiter les doublons de RESULTAT1.

Il faudrait que la quantité (C) des doublons refs (A) soit cumulé avec suppression des doublons.

J'ai mis ce code qui marche peut être qu'il y a plus simple à vous de me dire...

Sub caté1()

't = Timer()

Set f = Sheets("caté")

TblCaté = f.Range("D2:E" & f.[A65000].End(xlUp).Row).Value

xxxx = UBound(TblCaté)

Set f = Sheets("bd")

Tbl1 = f.Range("A2:S" & f.[A1000000].End(xlUp).Row).Value

Tbl = FiltreArrayCléColRécup(Tbl1, TblCaté, 1, Array(6, 7, 8, 14, 17, 18, 19, 1, 2))

If Not IsEmpty(Tbl) Then

Sheets("Résultat").[A2:I50000].ClearContents

Sheets("Résultat").[A2].Resize(UBound(Tbl), UBound(Tbl, 2) - LBound(Tbl, 2) + 1) = Tbl

End If

'MsgBox Timer - t

' regrouper avec cumul du stock dans RESULTAT

Set f = Sheets("Résultat")

Set f2 = Sheets("Résultat")

Tbl = f.Range("A2:R" & f.[A65000].End(xlUp).Row).Value

colCrit1 = 1

colOper = 3

Set d1 = CreateObject("Scripting.Dictionary")

Dim TblRes(): ReDim TblRes(1 To UBound(Tbl), 1 To UBound(Tbl, 2))

For i = LBound(Tbl) To UBound(Tbl)

temp = Tbl(i, colCrit1)

If Not d1.exists(temp) Then

d1(temp) = d1.Count + 1: lig = d1(temp)

For k = 1 To UBound(Tbl, 2): TblRes(lig, k) = Tbl(i, k): Next k

Else

lig = d1(temp): TblRes(lig, colOper) = TblRes(lig, colOper) + Tbl(i, colOper)

End If

Next i

Sheets("Résultat").[A2:I50000].ClearContents

f2.[A2].Resize(d1.Count, UBound(TblRes, 2)) = TblRes

End Sub

En appuyant sur Go caté1 / résultat dans BD, j'aimerai pouvoir calculer le nombre de mois selon la date Q R S a aujourd'hui avec ces règles.

si Q est vide et R n'est pas vide S n'est pas vide alors R à aujourd'hui avec nombre de mois en X

si Q n'est pas vide et R n'est pas vide S n'est pas vide alors Q à aujourd'hui avec nombre de mois en X

si Q vide et R n'est pas vide S vide alors R à aujourd'hui avec nombre de mois en X