VBA macro recherche par ligne

M

MLT

XLDnaute Nouveau
Bonjour,

J'essaye de faire un code pour rechercher ligne par ligne, le mot "azerty", si le mot est présent alors je veux supprimer la ligne: voici mon code:

Code: 
Sub supp_line()

If (InStr(1, Range("1:1").Select, azerty) <> 0) Then
Rows("1:1").Delete
End If
End Sub

le problème c'est que sa supprime la ligne dans tous les cas.

J'ai aussi fait ce code qui n'est pas fonctionnel:

Code: 
ligne As Integer
pointeur As String
ligne = 1
While ligne < 100
pointeur = Range("1:1").Select

If (InStr(1, pointeur, "azerty") <> 0) Then Rows(ligne & ":" & ligne).Delete
ligne = ligne + 1
End If
Wend
 
Trier par date Trier par votes
M

MLT

XLDnaute Nouveau
Re : VBA macro recherche par ligne

Il y a 1 élément que je comprends pas: la déclaration Dim WBK As Workbook, FichierChoisi
l'élément avec la virgule (FichierChoisi ) , pourquoi on le déclare comme sa ? WBK c'est le nom de la variable, Workbook c'est le type et après la virgule c'est encore un nom de variable ???
 
Dernière édition:
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : VBA macro recherche par ligne

Re

Dim WBK As Workbook, FichierChoisi ' déclaratons
Set WBK = ThisWorkbook
peut aussi s'écrire
' déclarations
Dim FichierChoisi
Dim WBK As Workbook
Set WBK = ThisWorkbook 'ici on indique que WBK* est le classeur contenant la macro


c'est ma façon de réduire le nombre de ligne de code ;)

*: WBK est un raccourci pour WorkBook
J'aurai pu choisir
Dim FichierChoisi
Dim CE_CLASSEUR as Workbook
Set CE_CLASSEUR=ThisWorkbook

D'autres questions ?
 
Vote positif 0 Vote négatif
M

MLT

XLDnaute Nouveau
Re : VBA macro recherche par ligne

Ok du coup, FichierChoisi n'as pas de type particulier , c'est bien sa ?

J'ai modifier le code:
Code: 
Sub choisir_fichier()
Dim WBK As Workbook, FichierChoisi ' déclaratons
Set WBK = ThisWorkbook
FichierChoisi = Application.GetOpenFilename("Fichiers Txt,*.txt")
Application.ScreenUpdating = False
  If Not FichierChoisi = False Then
    Workbooks.OpenText Filename:=FichierChoisi, DataType:=xlDelimited, Tab:=True
    ActiveWorkbook.Sheets(1).Copy WBK.Sheets(1) ' on copie tout dans le classeur stockant la macro
    
    
  End If
With WBK.Sheets(1)
    '--- 1ere ligne en gras
  .Range("A1", [A1].End(xlToRight)).Font.Bold = True
  
  
    '--- cadre
   
End With
Sheets(1).Name = "mesure"       'renommée l'onglet
Sheets("mesure").Move , Worksheets(Worksheets.Count)  'mettre l'onglet en question en dernier.
End Sub

Il reste un défault, le fichier .txt s'ouvre, je cherche un moyen de le fermer.

J'ai une autre question quand on met sheets(1), le 1 c'est le numéro d'onglet ?

PS: Que me conseillerez tu comme cours sur internet sur les macro excel ?
 
Vote positif 0 Vote négatif
M

MLT

XLDnaute Nouveau
Re : VBA macro recherche par ligne

J'ai un problème avec les if et les end if et pareil avec les boucles: voici le code:

Code: 
Sub choisir_fichier()
Dim WBK As Workbook, FichierChoisi ' déclaratons
Set WBK = ThisWorkbook
FichierChoisi = Application.GetOpenFilename("Fichiers Txt,*.txt")
Application.ScreenUpdating = False
  If Not FichierChoisi = False Then
    Workbooks.OpenText Filename:=FichierChoisi, DataType:=xlDelimited, Tab:=True
    ActiveWorkbook.Sheets(1).Copy WBK.Sheets(1) ' on copie tout dans le classeur stockant la macro
    
    
  End If
With WBK.Sheets(1)
    '--- 1ere ligne en gras
  .Range("A1", [A1].End(xlToRight)).Font.Bold = True
  
  
    '--- cadre
   
End With
Sheets(1).Name = "mesure"
Sheets("mesure").Move , Worksheets(Worksheets.Count)

'suppression des lignes en trop
Dim Cel As Range
Dim ligne As Integer
ligne = 1
While (ligne < 500)
Set Cel = Rows(ligne).Find("ANGLES")
If Not (Cel Is Nothing) Then                      'le if est là
While (pointeur < 13)
pointeur = ligne
Rows(pointeur).Delete
pointeur = pointeur + 1
Else
' rien faire
End If                    'erreur est ici, on dirait qu il voit pas le if
Wend
ligne = ligne + 1

Wend                                    'erreur aussi jai mis 2 while 

End Sub
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : VBA macro recherche par ligne

Re

Personnellement, pour supprimer des lignes selon un critère, je préfère employer le filtre automatique en VBA
(comme illustré dans ce fil dans un de mes précédent message)

Néanmoins, je vais essayer de voir ce qui cloche dans le Do / While ;)

EDITION: Par convention , on regroupe les Dim en début de code
Déjà, j'opterai pour les modifications ci-dessous
VB: 
Sub choisir_fichier()
Dim WBK As Workbook, FichierChoisi ' déclaratons
Set WBK = ThisWorkbook
FichierChoisi = Application.GetOpenFilename("Fichiers Txt,*.txt")
Application.ScreenUpdating = False
  If Not FichierChoisi = False Then
    Workbooks.OpenText Filename:=FichierChoisi, DataType:=xlDelimited, Tab:=True
    ActiveWorkbook.Sheets(1).Copy WBK.Sheets(1) ' on copie tout dans le classeur stockant la macro
End If
With WBK.Sheets(1)
    '--- 1ere ligne en gras
  .Range("A1", [A1].End(xlToRight)).Font.Bold = True
  .Name = "mesure"
End With
WBK.Sheets("mesure").Move , WBK.Worksheets(WBK.Worksheets.Count)
' je vais voir maintenant le reste de ton code ;-)
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : VBA macro recherche par ligne

RE


Finalement je préfère te soumettre ma façon de faire
(c'est plus rapide pour moi ;) )
J'ai testé avec ton fichier mesure.txt
Cela semble bon comme résultat, non ?
VB: 
Sub choisir_fichier()
Dim WBK As Workbook, FichierChoisi ' déclarations
Dim pf As Range
Set WBK = ThisWorkbook
FichierChoisi = Application.GetOpenFilename("Fichiers Txt,*.txt")
Application.ScreenUpdating = False
  If Not FichierChoisi = False Then
    Workbooks.OpenText Filename:=FichierChoisi, DataType:=xlDelimited, Tab:=True
    ActiveWorkbook.Sheets(1).Copy WBK.Sheets(1) ' on copie tout dans le classeur stockant la macro
  End If
With WBK.Sheets(1)
'--- 1ere ligne en gras
    .Range("A1", [A1].End(xlToRight)).Font.Bold = True
    .Name = "mesure"
End With
WBK.Sheets("mesure").Move , WBK.Worksheets(WBK.Worksheets.Count)
'suppression des lignes en trop
With WBK.Sheets("mesure")
    .Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    .Range("A1").AutoFilter Field:=1, Criteria1:="ANGLES"
    Set pf = .Range("_FilterDataBase")
    pf.Offset(1, 0).Resize(pf.Rows.Count - 1).SpecialCells(12).EntireRow.Delete
    .ShowAllData
    .AutoFilterMode = False
End With
End Sub

PS: je laisse le soin aux autres membres du forum de te proposer une correction de ton code initial.

Bonne fin de soirée et A+ sur XLD.
 
Vote positif 0 Vote négatif
M

MLT

XLDnaute Nouveau
Re : VBA macro recherche par ligne

oui c'est a peu pres sa, en fait je veux supprimer la ligne où il y a "ANGLES" et les 12 lignes en dessous.

Ton code est assez compliqué pour moi, je vais mettre un moment à le décryper. Après c'est sur il y plus propre que le mien. ;)

Puis je vais continué à cherché se qui va pas dans les end if et wend, juste pour apprendre.
 
Vote positif 0 Vote négatif
Staple1600

Staple1600

XLDnaute Barbatruc
Re : VBA macro recherche par ligne

Bonjour MLT, le fil,le forum

Avant d'aller prendre ma douche, j'ai cogité sur ton affaire
Et plutôt que d'utiliser le filtre automatique, j'opte pour le filtre élaboré
Est-ce le résultat final que tu souhaites ?
Si tu as des questions, je repasserai sur le forum après le taf
VB: 
Sub choisir_fichierII()
Dim Mon_FiltreA
Dim WBK As Workbook, TXTFile As Workbook, FichierChoisi ' déclarations
Dim pf As Range
Set WBK = ThisWorkbook
Mon_FiltreA = Array("FILE", "ANGLES", "CNTCT#", "STDDEV", "DISTS ", "GAPS", "A", "B")
FichierChoisi = Application.GetOpenFilename("Fichiers Txt,*.txt")
Application.ScreenUpdating = False
  If Not FichierChoisi = False Then
    Workbooks.OpenText Filename:=FichierChoisi, DataType:=xlDelimited, Tab:=True
    Set TXTFile = ActiveWorkbook
    ActiveWorkbook.Sheets(1).Copy WBK.Sheets(1) ' on copie tout dans le classeur stockant la macro
    TXTFile.Close False ' on ferme mesure.txt
 End If
With WBK.Sheets(1)
'--- 1ere ligne en gras
   .Range("A1", [A1].End(xlToRight)).Font.Bold = True
    .Name = "mesure"
End With
WBK.Sheets("mesure").Move , WBK.Worksheets(WBK.Worksheets.Count)
'suppression des lignes en trop
With WBK.Sheets("mesure")
    .Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    .Range("N1:N8") = Application.Transpose(Mon_FiltreA)
    .Range("A1:A" & .[A65536].End(xlUp).Row).AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=Range("N1:N8"), Unique:=False
    Set pf = .Range("_FilterDataBase")
    pf.Offset(1, 0).Resize(pf.Rows.Count - 1).SpecialCells(12).EntireRow.Delete
    .ShowAllData
    .Columns(14).Delete
End With
End Sub
 
Vote positif 0 Vote négatif

Discussions similaires

C
  • Résolu(e)
XL 2010 Delete
Réponses
5
Affichages
248
job75
job75
Y
  • Question
Microsoft 365 Insérer des lignes selon variable
Réponses
1
Affichages
233
gbinforme
G
chaelie2015
  • Résolu(e)
XL 2013 (RESOLU) Code afficher/Masquer problème
Réponses
10
Affichages
235
chaelie2015
chaelie2015
petitbuzuc
  • Question
XL 2016 Aide pour maj auto de la date + selection multiple dans une liste déroulante
Réponses
5
Affichages
239
fanch55
fanch55
D
  • Question
XL 2010 suppression de lignes dans un fichier EXCEL via une routine en VBA
Réponses
2
Affichages
268
mapomme
mapomme
S
  • Résolu(e)
Microsoft 365 Récupérer la date dans un calendrier
Réponses
2
Affichages
122
sebastien176
S
N
  • Question
Microsoft 365 Aide adaptation d'une macro
Réponses
2
Affichages
115
netparty
N
halecs93
  • Question
XL 2016 Masquer et afficher lignes
Réponses
3
Affichages
109
gbinforme
G
R
  • Question
XL 2016 excel 2016 VBA
Réponses
2
Affichages
161
rebatte
R
F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
195
Francky79
F

Membres actuellement en ligne

2 membres et 74 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 305
Messages
2 087 084
Membres
103 459
dernier inscrit
Arnocal