Discussion:
VBA - filtrage des valeurs et supprimer les valeurs non requis
(trop ancien pour répondre)
Alexislaroche
2020-05-16 07:30:10 UTC
Permalink
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:@***@j0
***@56:)hquct36A
***@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)

Loading Image...
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.
Loading Image...

Loading Image...

J'ai un code qui fonctionne pour effacer les cellules vides.
Mais je voudrais un code pour effacer les valeurs des cellules qui ne respect
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 es
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
alexislaroche
2020-05-16 07:57:09 UTC
Permalink
Post by 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
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 n
respecte
Post by Alexislaroche
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
Application.ScreenUpdating = True
Exit Sub
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. mai
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)) =
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
Michel__D
2020-05-16 12:39:51 UTC
Permalink
Bonjour,
Post by 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
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
alexislaroche
2020-05-17 05:36:44 UTC
Permalink
Post by Alexislaroche
Bonjour,
Post by 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
:)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)
(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
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

MichD
2020-05-16 13:32:37 UTC
Permalink
Bonjour,

Un fichier exemple montrant comment arriver à tes fins sans macro si la
chose t'intéresse!

https://www.cjoint.com/c/JEqnFDZO2Kj

MichD
MichD
2020-05-16 13:40:28 UTC
Permalink
Post by Alexislaroche
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
Loading...