Discussion :

[houssem1807]

Bonjour à tous

pb : je souhaiterais svp accélérer l’exécution de mon code.

données : j'ai une feuille 1 dans laquelle j'ai en colonne A les codes Articles, en B les numéros de non conformité (s'il y en a une), en C la date des non conformités et en D le nom de fournisseur de chaque code article. Ensuite en feuille 2 j'ai en colonne A des codes articles en B les noms de fournisseurs et en C des dates (ordre croissant).

code : je souhaiterais que lorsque dans la feuille 1, la colonne B est différente de vide je récupère la date dans la cellule adjacentes (variable 1) ainsi que le code article (variable 2) et le nom du fournisseur (variable 3) puis je vais dans la feuille 2. Maintenant je parcours la colonne C (les dates) et lorsque je trouve la première date supérieur à variable 1 à partir de cette cellule jusqu'à la fin je cherche dans la colonne A la variable 2 si je la trouve je vérifie que la cellule adjacente portant le nom du fournisseur est la même que variable 3 et si c'est le cas j'incrémente une variable (var) de 1 . une fois terminé je dis que la cellule E de la feuille 1 du code article concerné est égale à var.

voila un exemple que je viens de fabriquer pour vous aidez à comprendre: acc code.xlsx



maintenant voila ce que moi j'ai fait mais je vous préviens c'est très long :/ :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
 
Sub RSC1()
 
Dim LigneF2 As Long
Dim LigneF4 As Long
Dim i As Long, j As Long, N As Long
Dim var As Integer
Dim variable1 As Variant, variable2 As Variant
LigneF2 = Sheets("Feuil2").Range("A" & Rows.Count).End(xlUp).Row
LigneF4 = Sheets("Feuil4").Range("A" & Rows.Count).End(xlUp).Row
var = 0
For i = 1 To LigneF2
    If Sheets("Feuil2").Cells(i, 4).Value <> "" Then
        variable1 = Sheets("Feuil2").Cells(i, 1).Value
        variable2 = Sheets("Feuil2").Cells(i, 5).Value
        variable3 = Sheets("Feuil2").Cells(i, 3).Value
 
        For j = 1 To LigneF4
 
            If Sheets("Feuil4").Cells(j, 1).Value = variable1 Then
                If Sheets("Feuil4").Cells(j, 3).Value > variable2 Then
                    If Sheets("Feuil4").Cells(j, 2).Value = variable3 Then
                        var = var + 1
                    End If
                End If
            End If
        Next j
        Sheets("Feuil2").Cells(i, 8).Value = var
 
    End If
    var = 0
 
Next i
 
 
End Sub

merci à vous

[casefayere]

Bonjour,
sans avoir testé, je me suis contenté de reprendre ton code en remplaçant les plages par des variables tableaux, donc à vérifier et corriger au besoin, j'ai estimé que tes données commencent en ligne 2, la ligne 1 pour les titres

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub RSC1()
 
Dim LigneF2 As Range, TbF2
Dim LigneF4 As Range, TbF4
Dim i As Long, j As Long
Dim var As Integer
Dim variable1 As Variant, variable2 As Variant
LigneF2 = Sheets("Feuil2").Range("A" & Sheets("Feuil2").Rows.Count).End(xlUp).Row
LigneF4 = Sheets("Feuil4").Range("A" & Sheets("Feuil4").Rows.Count).End(xlUp).Row
var = 0
TbF2 = Sheets("Feuil2").Range("A2", LigneF2(1, 8))
TbF4 = Sheets("Feuil4").Range("A2", LigneF4(1, 8))
 
For i = 1 To UBound(TbF2, 1)
  If TbF2(i, 4) <> "" Then
    variable1 = TbF2(i, 1)
    variable2 = TbF2(i, 5)
    variable3 = TbF2(i, 3)
    For j = 1 To UBound(TbF4, 1)
      If TbF4(j, 1) = variable1 Then
        If TbF4(j, 3) = variable2 Then
          If TbF4(j, 2) = variable3 Then
            var = var + 1
          End If
        End If
      End If
    Next j
    Sheets("Feuil2").Cells(i + 1, 8).Value = var'si encore trop long on pourra modifier ici, "i + 1" car on commence en A2
  End If
  var = 0
Next i
End Sub

[gFZT82]

Bonjour,

Voici comment j'ai traduit ton code :

En Feuil2 :
- en colonne A les codes Articles,
- en colonne C le nom de fournisseur de chaque code article.
- en colonne D les numéros de non conformité (s'il y en a une),
- en colonne E la date des non conformités,

Ensuite, en Feuil4 :
- en colonne A des codes articles,
- en colonne B les noms de fournisseurs,
- en colonne C des dates de réception (ordre croissant).

Lorsqu'en Feuil2, la date de création est renseignée, je recherche en Feuil4-colonne C la première date de réception supérieure à cette date.
A partir de cette cellule jusqu'à la fin je cherche dans la colonne A le code article correspondant.
Si je le trouve, je vérifie la correspondance du nom du fournisseur.
Si cette correspondance est vérifiée, j'incrémente un compteur (variable Cptr) .
Une fois le traitement terminé, la valeur Cptr est notée dans la colonne H de la Feuil2, sur la ligne du code article concerné.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
Sub RSC1()
Dim WsS As Worksheet
Dim DateC As Range, Fournisseur As Range
Dim LigneD As Long, LigneF As Long
Dim Cptr As Integer
Dim firstAddress As String
    Set WsS = Worksheets("Feuil4")
    With Worksheets("Feuil2")
        For Each DateC In .Range("E2", .Range("E" & Rows.Count).End(xlUp))
            If DateC <> "" Then
                LigneF = WsS.Range("C" & Rows.Count).End(xlUp).Row
                LigneD = Application.Match(CLng(DateC), WsS.Columns(3), 1) + 1
                Set Fournisseur = WsS.Range(WsS.Cells(LigneD, 1), WsS.Cells(LigneF, 1)).Find(DateC.Offset(, -4), , xlValues, xlWhole)
                If Not Fournisseur Is Nothing Then
                    firstAddress = Fournisseur.Address
                    Do
                        If Fournisseur.Offset(, 1) = DateC.Offset(, -2) Then
                            Cptr = Cptr + 1
                            Set Fournisseur = WsS.Range(WsS.Cells(LigneD, 1), WsS.Cells(LigneF, 1)).FindNext(Fournisseur)
                        End If
                    Loop While Not Fournisseur Is Nothing And Fournisseur.Address <> firstAddress
                End If
                DateC.Offset(, 3) = Cptr
                Cptr = 0
            End If
        Next DateC
    End With
    Set WsS = Nothing
End Sub

Cordialement.

[patricktoulon]

Bonsoir
pour moi un simple filtre avec 2 (field/criterial) ferait l'affaire pour le sheets(4)
pour le sheets(2 seulement 1 sur les non vides
résultat quasi instantané
a mediter

[houssem1807]

Merci à vous tous,
alors je suis actuellement entrain de travailler sur les deux premiers codes :
gFZT82,

j'ai une erreur d'incompatibilité de type sur la ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
LigneD = Application.Match(CLng(DateC), WsS.Columns(3), 1) + 1

je pense que le fais de comparer une valeur numérique à une valeur date pose pb, je vais essayer d'avoir le même type de données à comparer. de plus normalement Si l’argument expression passé à la fonction excède la plage de valeurs du type de données cible, une erreur se produit. (remarque aide vba)

casefayere,

sur ton code j'ai une erreur sur d'incompatibilité de type aussi sur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

TbF2 = Sheets("Feuil2").Range("A2", LigneF2(1, 8))

alors je ne comprends pas ce que tu essayes de faire car tu utilises la variable LigneF2 comme si c'était une cellule! je suppose que tu essayes d'alimenter le tableau alors je vais essayer quelque chose de différent.

si les deux codes sont trop long je testerais la méthode de filtres
en tout cas merci à vous.

Bonjour gFZT82,

je n'arrive pas à résoudre le problème d'incompatibilité, j'ai essayer différentes choses mais ca ne marche pas peux tu m'aider STP ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

LigneD = Application.Match(CLng(DateC), WsS.Columns(3), 1) + 1

[gFZT82]

L'instruction Application.Match(CLng(DateC), WsS.Columns(3), 1) permet de renvoyer la position relative de la date dans la colonne C de la Feuil4.

Note bien que le 3ème argument (type) est égal à 1 pour que la recherche se fasse sur la valeur la plus élevée qui est inférieure ou égale à la date.
Les dates de la colonne C doivent être triées en ordre croissant, soit du plus ancien au plus récent.

Cordialement.