Sub SupLignes()
Dim ValMin, ValMax, DL, L
Application.ScreenUpdating = False
ValMin = Val(Split([V2].FormatConditions(2).Formula1, "=")(1)) ' Recup val min filtrage
ValMax = Val(Split([V2].FormatConditions(3).Formula1, "=")(1)) ' Recup val max filtrage
DL = [V100000].End(xlUp).Row ' Dernière ligne
For L = DL To 2 Step -1 ' Si <Valmin et >ValMax on supprime la ligne
If Cells(L, "V") < ValMin Or Cells(L, "V") > ValMax Then Rows(L).Delete Shift:=xlUp
Next L
End Sub
=SI(OU(J2<20;K2<20;L2<25,3;M2<25,3;N2<4;O2<4;P2>0,5;Q2>0,5;R2>0,3;V2<1378;V2>1381);LIGNE();"")
Sub SupLignes()
Dim ValMin, ValMax, DL, L
Application.ScreenUpdating = False
ValMin = Val(Split([V2].FormatConditions(2).Formula1, "=")(1)) ' Recup val min filtrage
ValMax = Val(Split([V2].FormatConditions(3).Formula1, "=")(1)) ' Recup val max filtrage
DL = [V100000].End(xlUp).Row ' Dernière ligne
For L = DL To 2 Step -1 ' Si <Valmin et >ValMax on supprime la ligne
If Cells(L, "V") < ValMin Or Cells(L, "V") > ValMax Then Rows(L).Delete Shift:=xlUp
Next L
End Sub
Merci c'est bien ce que je veux par contre excel me bloque ta macroBonjour Snipe, Njhub,
Un essai en PJ avec :
NB : Le bouton gris sert à ré initialiser le tableau pour les tests.VB:Sub SupLignes() Dim ValMin, ValMax, DL, L Application.ScreenUpdating = False ValMin = Val(Split([V2].FormatConditions(2).Formula1, "=")(1)) ' Recup val min filtrage ValMax = Val(Split([V2].FormatConditions(3).Formula1, "=")(1)) ' Recup val max filtrage DL = [V100000].End(xlUp).Row ' Dernière ligne For L = DL To 2 Step -1 ' Si <Valmin et >ValMax on supprime la ligne If Cells(L, "V") < ValMin Or Cells(L, "V") > ValMax Then Rows(L).Delete Shift:=xlUp Next L End Sub
Sub Sup_Rouge()
Dim Rw As Integer, Cl As Range
Const Target_Color = 393372 ' le rouge de la MFC
For Rw = [Test].Rows.Count To 1 Step -1
For Each Cl In [Test].Rows(Rw).Columns
If Cl.DisplayFormat.Font.Color = Target_Color Then
Cl.EntireRow.Delete
Exit For
End If
Next
Next
End Sub
super merciAutorisez les macros :
Regarde la pièce jointe 1187293
Petite questionBonjour Snipe, Njhub,
Un essai en PJ avec :
NB : Le bouton gris sert à ré initialiser le tableau pour les tests.VB:Sub SupLignes() Dim ValMin, ValMax, DL, L Application.ScreenUpdating = False ValMin = Val(Split([V2].FormatConditions(2).Formula1, "=")(1)) ' Recup val min filtrage ValMax = Val(Split([V2].FormatConditions(3).Formula1, "=")(1)) ' Recup val max filtrage DL = [V100000].End(xlUp).Row ' Dernière ligne For L = DL To 2 Step -1 ' Si <Valmin et >ValMax on supprime la ligne If Cells(L, "V") < ValMin Or Cells(L, "V") > ValMax Then Rows(L).Delete Shift:=xlUp Next L End Sub
J'ai déjà essayé mais ça fonctionne pasRe-,
Pour info, une simple mise à jour de la requête nécessitera de re-dérouler le code...
Alors que ce serait faisable dès la requête...
Bref, à toi de voir...
Mais je suis bon d'accord que moi j'y arrives pasRe-,
Ok, tu as essayé...
Qui te dit que nous ne pourrions y arriver?
Et le nombre de fichiers importe peu...
Si tu pouvais ne mettre que 2 ou 3 fichiers, on pourrait t'indiquer la façon de faire, peut-être?
Les fichiers dans un zip, afin de pouvoir être mis en ligne
Si ça t'intéresse, bien sûr...
Alors oui j'avais compilé mon fichier zip au tout début avant de revérifier toutes mes données.Re-,
Dans le fichier "TR_1001_BO_bj015_ES_201988.CSV", tu n'as aucune opération, c'est normal?
Normalement, en colonne E, il y a les opérations, sauf dans celui-là...
J'ai donc rajouté les 3 opérations "normales"...
Et dans le fichier "TR_1003_BO_bi001_ES_17817.CSV", il n'y a aucune mesure pour le voile droit en colonne S...
Dans la requête, je remplace donc l'error par un "Manque mesure" en colonne AA
Dans le fichier joint, tu renseignes le chemin du dossier dans l'onglet "Paramètres", dans la cellule A2.
Tous les CSV sont chargés.
Dans la requête, je n'ai effectué aucun filtre final, je te laisse le faire (si tu ne veux conserver que les "OK", ou les "KO" et "Manque mesure", tu as le choix)
Si tu n'y arrives pas, reviens
Bonne soirée
A rien. Simplement cela permet de copier le tableau dans la feuille Test ... pour faire des tests. ( bouton gris )A quoi sert ta feuille REF?
je cherche a conserver uniquement les lignes qui contiennent du texte rouge
Sub NiNoirNiBlanc()
Dim lst As ListObject, i&, x, dpf, BW As Boolean
Application.ScreenUpdating = False
Set lst = Sheets("test").Range("a1").ListObject
For i = lst.ListRows.Count To 1 Step -1
BW = True
For Each x In lst.ListRows(i).Range
If x <> "" Then
dpf = x.DisplayFormat.Font.Color
If dpf <> vbBlack And dpf <> vbWhite Then BW = False: Exit For
End If
Next x
If BW Then lst.ListRows(i).Delete
Next i
End Sub