Logo GNT
Actualités Tests & Guides Bons Plans
Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11
Entraide Applications Microsoft Office Excel VBA - filtrage des valeurs et supprimer les valeurs non requis

VBA - filtrage des valeurs et supprimer les valeurs non requis

5 réponses
Avatar
Alexislaroche
Bonjour,

Je suis débutant avec excel vba.

Je voudrais pourvoir effacer les valeurs qui ne respecte pas certain critères.

df!gf:mqichgfdcg
test)2:@1jhbh5@j0
est@56:)hquct36A
h@hy.ju:A3)nxhd123QW
tempghj#b:jkb
temp234!A:gfgcjhgcj,hgk
hgdfht:2345vk!
hgchghc:268678954
hgchghc:A268678954

- Le filtre doit commencer après le caractère: (pour chaque cellule)
- Il doit y avoir au moins 10 caractères après le : (majuscules, minuscules, chiffres, caractères spéciaux)

https://i.imgur.com/3XiECI7.jpg
Ces cellules (A:3, A:5, A:7, A:8) ne respectent pas les critères.

- Effacez les lignes qui ne respectent pas les critères.
https://i.imgur.com/12N5k2O.jpg

https://i.imgur.com/O3nIzDt.jpg

J'ai un code qui fonctionne pour effacer les cellules vides.
Mais je voudrais un code pour effacer les valeurs des cellules qui ne respecte pas les critères.

VOICI LE CODE POUR SÉLECTION SELON LES CRITÈRES
________________________________________________________

Sub test1()
Dim OriginText, filterVal, startPosition
Dim ThereIs10Char As Boolean
Application.ScreenUpdating = False

For i = 1 To 15
OriginText= Cells(i, "e;e;e;A"e;e;e;).Value
startPosition = InStr(1, OriginText, "e;e;e;:"e;e;e;)
filterVal = Mid(OriginText, startPosition + 1, Len(OriginText) - startPosition)
ThereIs10Char = False
If Len(filterVal >= 10) Then
ThereIs10Char = True
End If

' à partir de la que je comprend pas je pense que le début du code est bon. mais je ne suis pas certain.

If ThereIs10Char = True Then
cells(i).ClearContents
i = i - 1
End If
Next

Application.ScreenUpdating = True
End Sub




VOICI LE CODE POUR EFFACER LES CELLULES VIDES.
________________________________________________________

Option Explicit

Sub Sample()
Dim i As Long
Dim DelRange As Range

On Error GoTo Whoa

Application.ScreenUpdating = False

For i = 1 To 1000
If Application.WorksheetFunction.CountA(Range("e;e;A"e;e; & i & "e;e;:"e;e; & "e;e;B"e;e; & i)) = 0 Then
If DelRange Is Nothing Then
Set DelRange = Range("e;e;A"e;e; & i & "e;e;:"e;e; & "e;e;B"e;e; & i)
Else
Set DelRange = Union(DelRange, Range("e;e;A"e;e; & i & "e;e;:"e;e; & "e;e;B"e;e; & i))
End If
End If
Next i

If Not DelRange Is Nothing Then DelRange.Delete shift:=xlUp
LetsContinue:
Application.ScreenUpdating = True

Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
Signaler un problème avec ce contenu

5 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
alexislaroche
Le samedi 16 Mai 2020 à 09:30 par Alexislaroche :
Bonjour,
Je suis débutant avec excel vba.
Je voudrais pourvoir effacer les valeurs qui ne respecte pas certain
critères.
df!gf:mqichgfdcg
test)2:@
:)hquct36A
:A3)nxhd123QW
tempghj#b:jkb
temp234!A:gfgcjhgcj,hgk
hgdfht:2345vk!
hgchghc:268678954
hgchghc:A268678954
- Le filtre doit commencer après le caractère: (pour chaque
cellule)
- Il doit y avoir au moins 10 caractères après le : (majuscules,
minuscules, chiffres, caractères spéciaux)
https://i.imgur.com/3XiECI7.jpg
Ces cellules (A:3, A:5, A:7, A:8) ne respectent pas les critères.
- Effacez les lignes qui ne respectent pas les critères.
https://i.imgur.com/12N5k2O.jpg
https://i.imgur.com/O3nIzDt.jpg
J'ai un code qui fonctionne pour effacer les cellules vides.
Mais je voudrais un code pour effacer les valeurs des cellules qui ne respecte
pas les critères.
VOICI LE CODE POUR SÉLECTION SELON LES CRITÈRES
________________________________________________________
Sub test1()
Dim OriginText, filterVal, startPosition
Dim ThereIs10Char As Boolean
Application.ScreenUpdating = False
For i = 1 To 15
OriginText= Cells(i, "e;e;e;A"e;e;e;).Value
startPosition = InStr(1, OriginText, "e;e;e;:"e;e;e;)
filterVal = Mid(OriginText, startPosition + 1, Len(OriginText) -
startPosition)
ThereIs10Char = False
If Len(filterVal >= 10) Then
ThereIs10Char = True
End If
' à partir de la que je comprend pas je pense que le
début du code est bon. mais je ne suis pas certain.
If ThereIs10Char = True Then
cells(i).ClearContents
i = i - 1
End If
Next
Application.ScreenUpdating = True
End Sub
VOICI LE CODE POUR EFFACER LES CELLULES VIDES.
________________________________________________________
Option Explicit
Sub Sample()
Dim i As Long
Dim DelRange As Range
On Error GoTo Whoa
Application.ScreenUpdating = False
For i = 1 To 1000
If Application.WorksheetFunction.CountA(Range("e;e;A"e;e;
& i & "e;e;:"e;e; & "e;e;B"e;e; & i)) = 0
Then
If DelRange Is Nothing Then
Set DelRange = Range("e;e;A"e;e; & i &
"e;e;:"e;e; & "e;e;B"e;e; & i)
Else
Set DelRange = Union(DelRange, Range("e;e;A"e;e;
& i & "e;e;:"e;e; & "e;e;B"e;e; & i))
End If
End If
Next i
If Not DelRange Is Nothing Then DelRange.Delete shift:=xlUp
LetsContinue:
Application.ScreenUpdating = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
DÉSOLÉ UNE ERREUR S'EST GLISSÉE SUR LE CODE.
VOICI LE CODE POUR SÉLECTION SELON LES CRITÈRES
________________________________________________________
Sub test1()
Dim OriginText, filterVal, startPosition
Dim ThereIs10Char As Boolean
Application.ScreenUpdating = False
For i = 1 To 15
OriginText= Cells(i, "A").Value
startPosition = InStr(1, OriginText, ":")
filterVal = Mid(OriginText, startPosition + 1, Len(OriginText) - startPosition)
ThereIs10Char = False
If Len(filterVal >= 10) Then
ThereIs10Char = True
End If
' à partir de la que je comprend pas je pense que le début du code est bon. mais je ne suis pas certain.
If ThereIs10Char = True Then
cells(i).ClearContents
i = i - 1
End If
Next
Application.ScreenUpdating = True
End Sub
VOICI LE CODE POUR EFFACER LES CELLULES VIDES.
________________________________________________________
Option Explicit
Sub Sample()
Dim i As Long
Dim DelRange As Range
On Error GoTo Whoa
Application.ScreenUpdating = False
For i = 1 To 1000
If Application.WorksheetFunction.CountA(Range("A" & i & ":" & "B" & i)) = 0 Then
If DelRange Is Nothing Then
Set DelRange = Range("e;e;A"e;e; & i & ":" & "B" & i)
Else
Set DelRange = Union(DelRange, Range("A" & i & ":" & "B" & i))
End If
End If
Next i
If Not DelRange Is Nothing Then DelRange.Delete shift:=xlUp
LetsContinue:
Application.ScreenUpdating = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume LetsContinue
End Sub
Avatar
Michel__D
Bonjour,
Le 16/05/2020 à 09:57, alexislaroche a écrit :
Le samedi 16 Mai 2020 à 09:30 par Alexislaroche :
Bonjour,
Je suis débutant avec excel vba.
Je voudrais pourvoir effacer les valeurs qui ne respecte pas certain
critères.
df!gf:mqichgfdcg
test)2:@
:)hquct36A
:A3)nxhd123QW
tempghj#b:jkb
temp234!A:gfgcjhgcj,hgk
hgdfht:2345vk!
hgchghc:268678954
hgchghc:A268678954
- Le filtre doit commencer après le caractère: (pour chaque
cellule)
- Il doit y avoir au moins 10 caractères après le : (majuscules,
minuscules, chiffres, caractères spéciaux)
https://i.imgur.com/3XiECI7.jpg
Ces cellules (A:3, A:5, A:7, A:8) ne respectent pas les critères.
- Effacez les lignes qui ne respectent pas les critères.
https://i.imgur.com/12N5k2O.jpg
https://i.imgur.com/O3nIzDt.jpg


Voici une possibilitée à adapter comme tu veux :
Sub Test2()
Dim iLig As Long, iPos As Long
iLig = 1
Do Until iLig >= 15 Or Trim(Cells(iLig, 1).Value) = ""
iPos = InStr(Cells(iLig, 1).Value, ":")
If iPos > 0 And Len(Cells(iLig, 1).Value) - iPos <= 10 Then
Rows(iLig).Delete
Else
iLig = iLig + 1
End If
Loop
End Sub
Avatar
MichD
Bonjour,
Un fichier exemple montrant comment arriver à tes fins sans macro si la
chose t'intéresse!
https://www.cjoint.com/c/JEqnFDZO2Kj
MichD
Avatar
MichD
Le 16/05/20 à 09:32, MichD a écrit :
Bonjour,
Un fichier exemple montrant comment arriver à tes fins sans macro si la
chose t'intéresse!
https://www.cjoint.com/c/JEqnFDZO2Kj
MichD

C'est le même fichier, mais avec la totalité des données de ta question.
https://www.cjoint.com/c/JEqnNFZEk4j
MichD
Avatar
alexislaroche
Le samedi 16 Mai 2020 à 14:39 par Michel__D :
Bonjour,
Le 16/05/2020 à 09:57, alexislaroche a écrit :
Le samedi 16 Mai 2020 à 09:30 par Alexislaroche :
Bonjour,
Je suis débutant avec excel vba.
Je voudrais pourvoir effacer les valeurs qui ne respecte pas certain
critères.
df!gf:mqichgfdcg
test)2:@
:)hquct36A
:A3)nxhd123QW
tempghj#b:jkb
temp234!A:gfgcjhgcj,hgk
hgdfht:2345vk!
hgchghc:268678954
hgchghc:A268678954
- Le filtre doit commencer après le caractère: (pour chaque
cellule)
- Il doit y avoir au moins 10 caractères après le :
(majuscules,
minuscules, chiffres, caractères spéciaux)
https://i.imgur.com/3XiECI7.jpg
Ces cellules (A:3, A:5, A:7, A:8) ne respectent pas les critères.
- Effacez les lignes qui ne respectent pas les critères.
https://i.imgur.com/12N5k2O.jpg
https://i.imgur.com/O3nIzDt.jpg

Voici une possibilitée à adapter comme tu veux :
Sub Test2()
Dim iLig As Long, iPos As Long
iLig = 1
Do Until iLig >= 15 Or Trim(Cells(iLig, 1).Value) = ""
iPos = InStr(Cells(iLig, 1).Value, ":")
If iPos > 0 And Len(Cells(iLig, 1).Value) - iPos <= 10 Then
Rows(iLig).Delete
Else
iLig = iLig + 1
End If
Loop
End Sub
ça fonctionne parfaitement.
Merci