XL 2019 Accélérer le traitement de données par rapport à une formule.

Loïc DUBOIS · 21 Août 2023

Bonjour tout le monde,

J'espère que vous allez bien ?

Voici mon problème : je travaille actuellement avec des fichiers très gros (les bases de données brutes comprennent entre 400k et 950k lignes). J'utilise une formule très basique pour compter selon des critères (sur une seconde feuille) :
=NB.SI.ENS('Sheet 1'!B:B;Feuil1!A2;'Sheet 1'!E:E;Feuil1!D2;'Sheet 1'!H:H;Feuil1!G2) --> pour la colonne N dans "feuil1"
=NB.SI.ENS('Sheet 1'!$B:$B;feuil1!$A2;'Sheet 1'!$E:$E;feuil1!$D2;'Sheet 1'!$H:$H;feuil1!$G2;'Sheet 1'!$K:$K;feuil1!O$1) --> pour colonne O dans "feuil1".

Il est très facile d'appliquer cette formule sur toutes mes lignes mais mon jeu de donnée est trop conséquent et excel n'arrive pas à gérer une si grande base.

J'aimerais donc savoir s'il y a un moyen de contourner cela. En effet, excel crache très souvent après avoir attendu 3h+ pour que ma formule soit appliqué à 38000 lignes. Par exemple, est ce qu'en VBA les ressources utilisées sont moindres et donc le temps pour compter mes données serait plus faible ?

Je vous joins un fichier test.

Merci d'avance,

laurent950 · 22 Août 2023

Bonsoir @Loïc DUBOIS, Le Forum.

En complément du Poste #19 et du Poste #20

J'ai refait le code en passant avec un Module de Classe, et la Collection.
Compatible Windows et Macintosh

Module Standard

VB:

'Option Explicit
Sub CorrigeErrRefCompactTableauMacModuleDeClasse()
Application.ScreenUpdating = False
Dim t As Single
t = Timer
' Feuil 1 Résultat : Colonne N, O, P, Q, R, S, T
Dim FRes As Worksheet
    Set FRes = Worksheets("feuil1")
Dim ResPlage As Range
    Set ResPlage = FRes.Range(FRes.Cells(2, 1), FRes.Cells(FRes.Cells(1048576, 1).End(xlUp).Row, FRes.Cells(1, 16384).End(xlToLeft).Column))
Dim Tres()
    ReDim Tres(1 To ResPlage.Rows.Count, 1 To 7)
Dim Coll As Collection
    Set Coll = New Collection
Dim Res As ModClasseColl
Dim Val As Range
For Each Val In ResPlage.Resize(ResPlage.Rows.Count, 1)
    Set Res = New ModClasseColl: Res.Cpt = 0: Res.Cle = Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text: Coll.Add Res, Key:=Res.Cle ' ......................... N
    Set Res = New ModClasseColl: Res.Cpt = 0: Res.Cle = Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 15): Coll.Add Res, Key:=Res.Cle  ' O
    Set Res = New ModClasseColl: Res.Cpt = 0: Res.Cle = Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 16): Coll.Add Res, Key:=Res.Cle  ' P
    Set Res = New ModClasseColl: Res.Cpt = 0: Res.Cle = Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 17): Coll.Add Res, Key:=Res.Cle  ' Q
    Set Res = New ModClasseColl: Res.Cpt = 0: Res.Cle = Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 18): Coll.Add Res, Key:=Res.Cle ' R
    Set Res = New ModClasseColl: Res.Cpt = 0: Res.Cle = Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 19): Coll.Add Res, Key:=Res.Cle  ' S
    Set Res = New ModClasseColl: Res.Cpt = 0: Res.Cle = Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 20): Coll.Add Res, Key:=Res.Cle  ' T
Next
'
' -----------------------------------------------------------------------------------------------------------------------------------------------
' Feuil base : Sheet 1
Dim FBase As Worksheet
    Set FBase = Worksheets("Sheet 1")
Dim Tbase() As Variant
    Tbase = FBase.Range(FBase.Cells(2, 1), FBase.Cells(FBase.Cells(1048576, 1).End(xlUp).Row, FBase.Cells(1, 16384).End(xlToLeft).Column))
'
' -----------------------------------------------------------------------------------------------------------------------------------------------
' Resultat ' Colonne N
Dim i As Long
Dim Key As String
For i = LBound(Tbase, 1) To UBound(Tbase, 1)
    Key = Tbase(i, 2) & "-" & Tbase(i, 5) & "-" & Tbase(i, 8)
    Set Res = Coll.Item(Key)
    'MsgBox Res.Cpt: MsgBox Res.Cle
        If Res.Cle = Key Then
            Res.Cpt = Res.Cpt + 1
        End If
    Key = Tbase(i, 2) & "-" & Tbase(i, 5) & "-" & Tbase(i, 8) & "-" & Tbase(i, 11)
    Set Res = Coll.Item(Key)
    If Res.Cle = Key Then
        If Res.Cle = Key Then ' Tbase(i, 11) = Colonne K:K
            Res.Cpt = Res.Cpt + 1
        End If
    End If
Next i
    For Each Val In ResPlage.Resize(ResPlage.Rows.Count, 1)
        Set Res = Coll.Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text): Tres(Val.Row - 1, 1) = Res.Cpt
        Set Res = Coll.Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 15)): Tres(Val.Row - 1, 2) = Res.Cpt
        Set Res = Coll.Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 16)): Tres(Val.Row - 1, 3) = Res.Cpt
        Set Res = Coll.Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 17)): Tres(Val.Row - 1, 4) = Res.Cpt
        Set Res = Coll.Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 18)): Tres(Val.Row - 1, 5) = Res.Cpt
        Set Res = Coll.Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 19)): Tres(Val.Row - 1, 6) = Res.Cpt
        Set Res = Coll.Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 20)): Tres(Val.Row - 1, 7) = Res.Cpt
    Next
' resultat
    FRes.Cells(2, 14).Resize(UBound(Tres, 1), UBound(Tres, 2)).ClearContents
    FRes.Cells(2, 14).Resize(UBound(Tres, 1), UBound(Tres, 2)) = Tres
MsgBox Timer - t
Application.ScreenUpdating = True
End Sub

Créer un Module de classe et le renommé comme cela : ModClasseColl

Code:

Private Nb As Double
Private Key As String
Private Coll As Collection
Property Get Cpt() As Double
' Renvoi la valeur actuelle
   Cpt = Nb
End Property
Property Let Cpt(ByVal NewValue As Double)
' Mise à jour de la valeur
   Nb = NewValue
End Property
'
Property Get Cle() As String
' Renvoi la valeur actuelle
   Cle = Key
End Property
Property Let Cle(ByVal NewValue As String)
' Mise à jour de la valeur
   Key = NewValue
End Property

Le temps d'exécution est Réduit a combien de Minutes avec ce nouveau Code en passant avec un module de classe, Pour comparer en éliminant des tours de Boucles ?

Vous avez testé avec le code en Poste #19 sur votre fichier contenant 370k lignes. Pour 8 colonnes, cela prend moins de 5 minutes.
Puis tester avec 42 colonnes et cela prend autant de temps.

Loïc DUBOIS · 4 Octobre 2023

Bonjour le forum,

Désolé de revenir sur cette conversation. Je viens de vouloir refaire ce qu'on avait fait en aout. Mais lorsque j'applique le code de base j'ai une erreur : erreur d'exécution "457": cette clé est deja associée à un élément de cette collection.

En utilisant le debug cela vient de cette ligne =
Dim Val As Range
For Each Val In ResPlage.Resize(ResPlage.Rows.Count, 1)
coll(0).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text ' ......................... N

Avez-vous une solution ?

Maintenant, j'ai tenté la solution avec le module de classe (désolé je viens d'en prendre connaissance que maintenant) mais j'ia la même erreur : erreur d'exécution "457": cette clé est deja associée à un élément de cette collection.

ChTi160 · 4 Octobre 2023

Bonjour Loic , le Fil
as-tu essaie avec la gestion d'erreur ?

VB:

On Error Resume Next  
For Each Val In ResPlage.Resize(ResPlage.Rows.Count, 1)
     coll(0).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text
If Err.Number= 0 then
    coll(0).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text
Else
Err.Clear
End if
next Val
On Error GoTo 0

Non testé
Jean marie

Loïc DUBOIS · 4 Octobre 2023

Merci pour ta reponse, mais je le met dans quelle partie du code ? à la fin?

ChTi160 · 4 Octobre 2023

Re
je ne sais pas où se termine ta Boucle For Each
je n'ai pas le Code complet de la Procédure §
Jean marie

Loïc DUBOIS · 4 Octobre 2023

voila le code que j'utilise :

VB:

Option Explicit
Sub CorrigeErrRefCompactTableauMac()
Application.ScreenUpdating = False
Dim t As Single
t = Timer
' Feuil 1 Résultat : Colonne N, O, P, Q, R, S, T, U
Dim FRes As Worksheet
    Set FRes = Worksheets("feuil1")
Dim ResPlage As Range
    Set ResPlage = FRes.Range(FRes.Cells(2, 1), FRes.Cells(FRes.Cells(1048576, 1).End(xlUp).Row, FRes.Cells(1, 16384).End(xlToLeft).Column))
Dim Tres()
    ReDim Tres(1 To ResPlage.Rows.Count, 1 To 42)
Dim coll() As Collection
ReDim coll(0 To 41)
Set coll(0) = New Collection ' Colonne N
Set coll(1) = New Collection ' Colonne 0
Set coll(2) = New Collection ' Colonne P
Set coll(3) = New Collection ' Colonne Q
Set coll(4) = New Collection ' Colonne R
Set coll(5) = New Collection ' Colonne S
Set coll(6) = New Collection ' Colonne T
Set coll(7) = New Collection ' Colonne U
Set coll(8) = New Collection ' Colonne V
Set coll(9) = New Collection ' Colonne W
Set coll(10) = New Collection ' Colonne X
Set coll(11) = New Collection ' Colonne Y
Set coll(12) = New Collection ' Colonne Z
Set coll(13) = New Collection ' Colonne AA
Set coll(14) = New Collection ' Colonne AB
Set coll(15) = New Collection ' Colonne AC
Set coll(16) = New Collection ' Colonne AD
Set coll(17) = New Collection ' Colonne AE
Set coll(18) = New Collection ' Colonne AF
Set coll(19) = New Collection ' Colonne AG
Set coll(20) = New Collection ' Colonne AH
Set coll(21) = New Collection ' Colonne AI
Set coll(22) = New Collection ' Colonne AJ
Set coll(23) = New Collection ' Colonne AK
Set coll(24) = New Collection ' Colonne AL
Set coll(25) = New Collection ' Colonne AM
Set coll(26) = New Collection ' Colonne AN
Set coll(27) = New Collection ' Colonne AO
Set coll(28) = New Collection ' Colonne AP
Set coll(29) = New Collection ' Colonne AQ
Set coll(30) = New Collection ' Colonne AR
Set coll(31) = New Collection ' Colonne AS
Set coll(32) = New Collection ' Colonne AT
Set coll(33) = New Collection ' Colonne AU
Set coll(34) = New Collection ' Colonne AV
Set coll(35) = New Collection ' Colonne AW
Set coll(36) = New Collection ' Colonne AX
Set coll(37) = New Collection ' Colonne AY
Set coll(38) = New Collection ' Colonne AZ
Set coll(39) = New Collection ' Colonne BA
Set coll(40) = New Collection ' Colonne BB
Set coll(41) = New Collection ' ColonneBC

Dim Val As Range
For Each Val In ResPlage.Resize(ResPlage.Rows.Count, 1)
    coll(0).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text ' ......................... N
    coll(1).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 15) ' O
    coll(2).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 16) ' P
    coll(3).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 17) ' Q
    coll(4).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 18) ' R
    coll(5).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 19) ' S
    coll(6).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 20) ' T
    coll(7).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 21) ' U
    coll(8).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 22) ' O
    coll(9).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 23) ' P
    coll(10).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 24) ' Q
    coll(11).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 25) ' R
    coll(12).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 26) ' S
    coll(13).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 27) ' T
    coll(14).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 28) ' U
    coll(15).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 29) ' O
    coll(16).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 30) ' P
    coll(17).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 31) ' Q
    coll(18).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 32) ' R
    coll(19).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 33) ' S
    coll(20).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 34) ' T
    coll(21).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 35) ' U
    coll(22).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 36) ' O
    coll(23).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 37) ' P
    coll(24).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 38) ' Q
    coll(25).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 39) ' R
    coll(26).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 40) ' S
    coll(27).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 41) ' T
    coll(28).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 42) ' U
    coll(29).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 43) ' O
    coll(30).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 44) ' P
    coll(31).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 45) ' Q
    coll(32).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 46) ' R
    coll(33).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 47) ' S
    coll(34).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 48) ' T
    coll(35).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 49) ' U
    coll(36).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 50) ' O
    coll(37).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 51) ' P
    coll(38).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 52) ' Q
    coll(39).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 53) ' R
    coll(40).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 54) ' S
    coll(41).Add Item:=0, key:=Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 55) ' T
Next
'
' -----------------------------------------------------------------------------------------------------------------------------------------------
' Feuil base : Sheet 1
Dim FBase As Worksheet
    Set FBase = Worksheets("Sheet 1")
Dim Tbase() As Variant
    Tbase = FBase.Range(FBase.Cells(2, 1), FBase.Cells(FBase.Cells(1048576, 1).End(xlUp).Row, FBase.Cells(1, 16384).End(xlToLeft).Column))
'
' -----------------------------------------------------------------------------------------------------------------------------------------------
' Resultat ' Colonne N
Dim Cle As Variant
Dim j As Byte
Dim i As Long
Dim key As String
Dim cpt As Long
For i = LBound(Tbase, 1) To UBound(Tbase, 1)
    For j = LBound(coll) To UBound(coll)
      ' Test si la clé existe
        key = Tbase(i, 2) & "-" & Tbase(i, 5) & "-" & Tbase(i, 8)
        'Debug.Print Exists(coll, j, key)
        'Debug.Print coll(j).Item(Tbase(i, 2) & "-" & Tbase(i, 5) & "-" & Tbase(i, 8))
        If Exists(coll, j, key) = True Then
            If Tbase(i, 2) & "-" & Tbase(i, 5) & "-" & Tbase(i, 8) = key Then
                cpt = coll(j).Item(key) + 1
                coll(j).Remove key
                coll(j).Add Item:=cpt, key:=key
                cpt = Empty: key = Empty
            End If
        End If
        key = Tbase(i, 2) & "-" & Tbase(i, 5) & "-" & Tbase(i, 8) & "-" & Tbase(i, 11)
        If Exists(coll, j, key) = True Then
            If Tbase(i, 2) & "-" & Tbase(i, 5) & "-" & Tbase(i, 8) & "-" & Tbase(i, 11) = key Then ' Tbase(i, 11) = Colonne K:K
                cpt = coll(j).Item(key) + 1
                coll(j).Remove key
                coll(j).Add Item:=cpt, key:=key
                cpt = Empty: key = Empty
            End If
        End If
    Next j
Next i
j = Empty: i = Empty
    For Each Val In ResPlage.Resize(ResPlage.Rows.Count, 1)
        Tres(Val.Row - 1, 1) = coll(0).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text)
        Tres(Val.Row - 1, 2) = coll(1).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 15))
        Tres(Val.Row - 1, 3) = coll(2).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 16))
        Tres(Val.Row - 1, 4) = coll(3).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 17))
        Tres(Val.Row - 1, 5) = coll(4).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 18))
        Tres(Val.Row - 1, 6) = coll(5).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 19))
        Tres(Val.Row - 1, 7) = coll(6).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 20))
        Tres(Val.Row - 1, 8) = coll(7).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 21))
        Tres(Val.Row - 1, 9) = coll(8).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 22))
        Tres(Val.Row - 1, 10) = coll(9).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 23))
        Tres(Val.Row - 1, 11) = coll(10).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 24))
        Tres(Val.Row - 1, 12) = coll(11).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 25))
        Tres(Val.Row - 1, 13) = coll(12).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 26))
        Tres(Val.Row - 1, 14) = coll(13).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 27))
        Tres(Val.Row - 1, 15) = coll(14).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 28))
        Tres(Val.Row - 1, 16) = coll(15).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 29))
        Tres(Val.Row - 1, 17) = coll(16).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 30))
        Tres(Val.Row - 1, 18) = coll(17).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 31))
        Tres(Val.Row - 1, 19) = coll(18).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 32))
        Tres(Val.Row - 1, 20) = coll(19).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 33))
        Tres(Val.Row - 1, 21) = coll(20).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 34))
        Tres(Val.Row - 1, 22) = coll(21).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 35))
        Tres(Val.Row - 1, 23) = coll(22).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 36))
        Tres(Val.Row - 1, 24) = coll(23).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 37))
        Tres(Val.Row - 1, 25) = coll(24).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 38))
        Tres(Val.Row - 1, 26) = coll(25).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 39))
        Tres(Val.Row - 1, 27) = coll(26).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 40))
        Tres(Val.Row - 1, 28) = coll(27).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 41))
        Tres(Val.Row - 1, 29) = coll(28).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 42))
        Tres(Val.Row - 1, 30) = coll(29).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 43))
        Tres(Val.Row - 1, 31) = coll(30).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 44))
        Tres(Val.Row - 1, 32) = coll(31).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 45))
        Tres(Val.Row - 1, 33) = coll(32).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 46))
        Tres(Val.Row - 1, 34) = coll(33).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 47))
        Tres(Val.Row - 1, 35) = coll(34).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 48))
        Tres(Val.Row - 1, 36) = coll(35).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 49))
        Tres(Val.Row - 1, 37) = coll(36).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 50))
        Tres(Val.Row - 1, 38) = coll(37).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 51))
        Tres(Val.Row - 1, 39) = coll(38).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 52))
        Tres(Val.Row - 1, 40) = coll(39).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 53))
        Tres(Val.Row - 1, 41) = coll(40).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 54))
        Tres(Val.Row - 1, 42) = coll(41).Item(Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text & "-" & FRes.Cells(1, 55))

    Next
' resultat
    FRes.Cells(2, 14).Resize(UBound(Tres, 1), UBound(Tres, 2)).ClearContents
    FRes.Cells(2, 14).Resize(UBound(Tres, 1), UBound(Tres, 2)) = Tres
MsgBox Timer - t
Application.ScreenUpdating = True
End Sub
Function Exists(ByRef coll() As Collection, ByVal j As Byte, ByVal key As String) As Boolean
' Le code suivant vérifie si une clé existe
    On Error GoTo EH
    IsObject (coll(j).Item(key))
    Exists = True
EH:
End Function

ChTi160 · 4 Octobre 2023

Re
Peut être ainsi ,je me suis permis de Simplifier les Lignes en introduisant Une Variable "StrVal$"

VB:

Dim Val As Range
Dim StrVal$
For Each Val In ResPlage.Resize(ResPlage.Rows.Count, 1)
StrVal$ = Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text 'Ici
  
On Error Resume Next 'Gestion d'erreur éventuelle

    coll(0).Add item:=0, key:=Str ' ......................... N
    Err.Clear 'si erreur On efface
    coll(1).Add item:=0, key:=StrVal & "-" & FRes.Cells(1, 15) ' O
    Err.Clear 'Idem
    coll(2).Add item:=0, key:=StrVal & "-" & FRes.Cells(1, 16) ' P
    Err.Clear
    coll(3).Add item:=0, key:=StrVal & "-" & FRes.Cells(1, 17) ' Q
    Err.Clear
    coll(4).Add item:=0, key:=StrVal & "-" & FRes.Cells(1, 18) ' R
    Err.Clear
    coll(5).Add item:=0, key:=StrVal & "-" & FRes.Cells(1, 19) ' S
    Err.Clear
    coll(6).Add item:=0, key:=StrVal & "-" & FRes.Cells(1, 20) ' T
    Err.Clear
    coll(7).Add item:=0, key:=StrVal & "-" & FRes.Cells(1, 21) ' U
'''''
''''''
Etc etc
Next
On error GoTo 0 'On désactive la gestion d'erreur

Pas evident sans Fichier non testé !
Jean marie

Loïc DUBOIS · 4 Octobre 2023

Le code s'effectue mais le résultat ne fonctionne pas... Cela m'indique des 0 partout. Je ne comprend pas si je met mon code de base dans mes fichiers d'il y a 2 mois, cela fonctionne. Mais si je le met dans les nouveaux fichiers cela me met un problème de clé (cette clé est déjà associée à un élément de cette collection). y'a t il un conflit par rapport à mes anciens fichiers ? Est-il possible de supprimer les clés associée à la collection pour que mon code fonctionne ? faut il que je supprimer mes anciens fichiers ? etc.

Merci d'avance

ChTi160 · 4 Octobre 2023

Re
pas évident de t'aider Lol
Peut-être en ayant
Dim coll() As Collection
Puis en tête de procédure mettre
Set Coll = New Collecion
Set Coll = New Collection ' crée une nouvelle collection vide
à voir !
Jean marie

ChTi160 · 4 Octobre 2023

Autre question Lol
Pourquoi ne pas faire ceux-ci

VB:

On Error Resume Next
For Each Val In ResPlage.Resize(ResPlage.Rows.Count, 1)
           StrVal$ = Val.Text & "-" & Val.Offset(, 3).Text & "-" & Val.Offset(, 6).Text
   On Error Resume Next
          coll.Add item:=0, key:=Str ' ......................... N
    Err.Clear
    For i = 15 To 55
          coll.Add item:=0, key:=StrVal & "-" & FRes.Cells(1, i) '
    Next i
    Err.Clear 
Next Val
On Error GoTo 0

je n'ai pas compris la démarche du Fichier et donc de ses Procédures Lol
et pourquoi tant de Collection .
Jean marie

Loïc DUBOIS · 4 Octobre 2023

voici un autre fichier test.

Le but est de compter le nombre de concurrences selon les colonnes B, E, G et K du "Sheet 1" et selon les critères B1, E1, G1 et N1 (en sachant que N change si on est dans la colonne O alors c'est O1 etc.) En gros ca revient à appliquer la formule =NB.SI.ENS('Sheet 1'!$B:$B;Feuil1!$B2;'Sheet 1'!$E:$E;Feuil1!$E2;'Sheet 1'!$G:$G;Feuil1!$G2;'Sheet 1'!$K:$K;Feuil1!N$1) (le dernier critère change selon la colonne)

Après concernant ta solution, malheureusement je ne comprend rien en code, je ne sais absolument pas à quoi cela correspond ...

Merci d'avance,

Loïc

ChTi160 · 4 Octobre 2023

Re
Moi les formules c'est du Chinois Lol
je vais tenter de comprendre
je n'ai pas ouvert le fichier
donc je ne comprends pas

Le but est de compter le nombre de concurrences selon les colonnes B, E, G et K du "Sheet 1" Lol

Mais je vais ouvrir le Fichier Lol
Jean marie

Loïc DUBOIS · 4 Octobre 2023

c'est bon j'ai reussi à modifer le code initiale. Merci beaucoup pour vos commentaires

XL 2019 Accélérer le traitement de données par rapport à une formule.

Loïc DUBOIS

XLDnaute Occasionnel

laurent950

XLDnaute Barbatruc

Loïc DUBOIS

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

Loïc DUBOIS

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

Loïc DUBOIS

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

Loïc DUBOIS

XLDnaute Occasionnel

ChTi160

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Loïc DUBOIS

XLDnaute Occasionnel

Pièces jointes

ChTi160

XLDnaute Barbatruc

Loïc DUBOIS

XLDnaute Occasionnel

Discussions similaires