Filtre automatique

[EpsilonOne]

Bonjour,

Je suis en cours d'écriture d'une macro, qui doit filtrer la colonne "B", ensuite vérifier la valeur de la colonne "D", si elle correspond à 1 inscrire la valeur 0 dans la colonne "K", ensuite vérifier la valeur de la colonne "D" de la ligne filtrée suivante et récupérer la valeur de la ligne précédente de la colonne "A" pour aller l'écriture dans la colonne "K".

J'ai réussi à faire écrire 2 valeurs à la macro, mais au-delà ça marche pas, ci-joint un extrait du fichier excel (l'original fait plus de 8000 lignes) et la macro, celle-ci étant une macro en cours de dév, il ne faut pas forcément tenir compte de tout le code !

Si quelqu'un a une idée sur la méthode, je suis preneur ?

Sub Test()
Dim Cell_B As Range
Sheets("Feuil1").Activate
ActiveSheet.AutoFilterMode = False
c = 2

For Each Cell_B In Range("B" & c & ":B8628")
    Range("A1").AutoFilter field:=2, Criteria1:="=" & Cell_B
    Set Rng = ActiveSheet.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    NumRowsFiltre = Rng.SpecialCells(xlCellTypeVisible).Count - 1
        If NumRowsFiltre = 1 Then
            NumCol = Cell_B.Row - 1
            Range("K" & NumCol) = 0
        Else
            NumCol = Range("A" & NumRowsFiltre + 1).Row
            CellSuiv = NumRowsFiltre.FindNext(Cell_B)
           
            NumC = Range("D" & Cell_D + 1).Value
            If NumC <> 1 Then
                NumPCP = Range("A" & Cell_D).Value
            Else
                Range("K" & NumCol) = 0
            End If
        End If
ActiveSheet.AutoFilterMode = False
c = c + 1
Next
End Sub

Cordialement

 

[EpsilonOne]

Re : Filtre automatique

Bonjour,

finalement, j'ai réussi à écrire le code de la macro... le voici :

Dim Cell_B As Range
Sheets("Feuil1").Activate
ActiveSheet.AutoFilterMode = False
c = 2
For Each Cell_B In Range("B" & c & ":B8628")
    Range("A1").AutoFilter field:=2, Criteria1:="=" & Cell_B
    'Set Rng = ActiveSheet.Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
        For Each cell In Range("_FilterDataBase").Offset(1, 0).Resize(, 1)
            If cell.EntireRow.Hidden = False Then
                cell.Select
                NumCell = cell.Row
                NumCamp = Range("D" & NumCell).Value
                If NumCamp = 1 Then
                    Range("T" & NumCell).Value = 0
                    NCPrec = Range("A" & NumCell).Value
                Else
                    Range("K" & NumCell) = NCPrec
                    NCPrec = Range("A" & NumCell).Value
                End If
            End If
        Next
ActiveSheet.AutoFilterMode = False
c = c + 1
NumCell = 1
Next