Ne pas prendre en compte les lignes cachées par un filtre...

[olibelle0101]

Bonjour,

j'ai pu récupérer un code sur se site génial, mon fichier marche à merveille...
Le soucis c'est quand je filtre, la récupération des résultats est erroné .

J'ai une première feuille (Saisie) ou sont mes données (chaque jour une nouvelle ligne)
Et le calcul de ses données se fait dans 2è feuilles (Ecart)
par le moyen d'une macro , la voici :

Option Base 1
Dim Compteur(3) As Long
Dim Ecart(3) As Long
________________________________________________________________________________

Sub MajTableau()
Application.ScreenUpdating = False

'Extraction des données
With ThisWorkbook.Sheets("Saisie")
nombreEntrées = WorksheetFunction.CountA(.Range("A:A")) - 1
lastLine = .Range("A1048000").End(xlUp).Row
tableauSaisie = .Range(.Cells(3, 4), .Cells(lastLine, 28)).SpecialCells(xlCellTypeVisible).Value
tableauCompare = .Range(.Cells(3, 29), .Cells(lastLine, 34)).SpecialCells(xlCellTypeVisible).Value
ReDim tableauRésultat(9, UBound(tableauSaisie, 2))
End With

'Tests logiques sur les données
For i = 1 To 3 '-- pour chaque couleur
ligneValeur = 3 + 3 * (i - 1)
ligneColor = 2 + 3 * (i - 1)
ligneEcart = 1 + 3 * (i - 1)
For col = 1 To UBound(tableauSaisie, 2) '-- pour chaque colonne
tableauRésultat(ligneValeur, col) = 0 '- Compteur nombre valeurs
tableauRésultat(ligneColor, col) = 0 '- Compteur de case coloriées - i = 1 pour Jaune, 2 pour Vert, 3 pour Cian
tableauRésultat(ligneEcart, col) = 0 '- Compteur Ecart

For ligne = 1 To UBound(tableauSaisie, 1) '-- on parcourt le tableau de saisie
If tableauSaisie(ligne, col) <> "" Then
tableauRésultat(ligneEcart, col) = tableauRésultat(ligneEcart, col) + 1
tableauRésultat(ligneValeur, col) = tableauRésultat(ligneValeur, col) + 1
If tableauSaisie(ligne, col) = tableauCompare(ligne, 2 * i - 1) Or tableauSaisie(ligne, col) = tableauCompare(ligne, 2 * i) Then
tableauRésultat(ligneEcart, col) = 0
tableauRésultat(ligneColor, col) = tableauRésultat(ligneColor, col) + 1
End If
End If
Next ligne
Next col
Next i

'-- récupération des résultats
With ThisWorkbook.Sheets("Ecart")
.Range(.Cells(3, 2), .Cells(11, UBound(tableauSaisie, 2))).Value = tableauRésultat
End With
End Sub


Voilà, tout ça marche bien, tant que je ne filtre pas (comme le filtrage des noms propres en "AB")
Peut-on modifier ce code ?
Au cas ou PJ...

Bien cordialement.

 

[olibelle0101]

Re : Ne pas prendre en compte les lignes cachées par un filtre...

Ben en fait, est-ce que vous me suggérer de changer de code...
De travailler autrement... Ou autres.
je dois surement demander l'impossible.
Acceptez vous de lire les fichiers xlsm
Merci encore...

Option Base 1
Dim Compteur(3) As Long
Dim Ecart(3) As Long
__________________________________________________ ______________________________

Sub MajTableau()
Application.ScreenUpdating = False

'Extraction des données
With ThisWorkbook.Sheets("Saisie")
nombreEntrées = WorksheetFunction.CountA(.Range("A:A")) - 1
lastLine = .Range("A1048000").End(xlUp).Row
tableauSaisie = .Range(.Cells(3, 4), .Cells(lastLine, 28)).SpecialCells(xlCellTypeVisible).Value
tableauCompare = .Range(.Cells(3, 29), .Cells(lastLine, 34)).SpecialCells(xlCellTypeVisible).Value
ReDim tableauRésultat(9, UBound(tableauSaisie, 2))
End With

'Tests logiques sur les données
For i = 1 To 3 '-- pour chaque couleur
ligneValeur = 3 + 3 * (i - 1)
ligneColor = 2 + 3 * (i - 1)
ligneEcart = 1 + 3 * (i - 1)
For col = 1 To UBound(tableauSaisie, 2) '-- pour chaque colonne
tableauRésultat(ligneValeur, col) = 0 '- Compteur nombre valeurs
tableauRésultat(ligneColor, col) = 0 '- Compteur de case coloriées - i = 1 pour Jaune, 2 pour Vert, 3 pour Cian
tableauRésultat(ligneEcart, col) = 0 '- Compteur Ecart

For ligne = 1 To UBound(tableauSaisie, 1) '-- on parcourt le tableau de saisie
If tableauSaisie(ligne, col) <> "" Then
tableauRésultat(ligneEcart, col) = tableauRésultat(ligneEcart, col) + 1
tableauRésultat(ligneValeur, col) = tableauRésultat(ligneValeur, col) + 1
If tableauSaisie(ligne, col) = tableauCompare(ligne, 2 * i - 1) Or tableauSaisie(ligne, col) = tableauCompare(ligne, 2 * i) Then
tableauRésultat(ligneEcart, col) = 0
tableauRésultat(ligneColor, col) = tableauRésultat(ligneColor, col) + 1
End If
End If
Next ligne
Next col
Next i

'-- récupération des résultats
With ThisWorkbook.Sheets("Ecart")
.Range(.Cells(3, 2), .Cells(11, UBound(tableauSaisie, 2))).Value = tableauRésultat
End With
End Sub