Supprimer les lignes qui ne contienne pas de lien hypertexte
Bonjour,
j'aimerais savoir svp, si il est possible de créer une macro qui supprimerais les ligne entière si dans la colonne A les données ne contiennent pas de liens hypertexte (URL internet).
je savais pas quoi donner comme exemple donc en voila un quelconque :
A2 : voiture 1 (contenant un liens par exemple redirigeant sur le site de fiat)
A3 : prix (aucun liens)
A4 : statut (aucun liens)
A5 : voiture 2 (contenant un liens par exemple redirigeant sur le site de audi)
résultat souhaiter après la macro :
A2 : voiture 1 (contenant un liens par exemple redirigeant sur le site de fiat)
A3 : voiture 2 (contenant un liens par exemple redirigeant sur le site de audi)
la macro doit alors détecter quel cellule dans la colonne A ne contient pas de liens et supprimer la ligne entière
Merci d'avance
Bonjour
Code Module
Sub SupprimeLigneHyperlinks()
Dim Lien As Hyperlink
For Each Lien In ActiveSheet.Range("A:A").Hyperlinks
Range(Lien.Range.Address).EntireRow.Delete
Next
End SubCordialement
dans le même style
Sub ExtractionLiensHypertextes()
Dim Cell As Range
'Boucle sur la plage A1 /A5
For Each Cell In Range("A1:A5")
If Cell.Hyperlinks.Count = 0 Then
MsgBox "je supprime"
End If
Next Cell
End Sub
Bonsoir,
tout d'abord merci à vous 2 de votre aide pour mon problèmes.
Amadéus a écrit :Bonjour
Code Module
Sub SupprimeLigneHyperlinks() Dim Lien As Hyperlink For Each Lien In ActiveSheet.Range("A:A").Hyperlinks Range(Lien.Range.Address).EntireRow.Delete Next End SubCordialement
amadeus ta macro fonctionnent bien sauf que c'est excatement le contraire que je demander
une macro qui supprimerais les ligne entière si dans la colonne A les données ne contiennent pas de liens hypertexte(URL internet).
or actuellement elle me supprime toutes celle qui ont des liens
A2 : voiture 1 (contenant un liens par exemple redirigeant sur le site de fiat)
A3 : prix (aucun liens)
A4 : statut (aucun liens)
A5 : voiture 2 (contenant un liens par exemple redirigeant sur le site de audi)
résultat souhaiter après la macro :
A2 : voiture 1 (contenant un liens par exemple redirigeant sur le site de fiat)
A3 : voiture 2 (contenant un liens par exemple redirigeant sur le site de audi)
PS les " ... " signifier également que le tableur continuer bien après la cellule A5
gullaud a écrit :dans le même style
Sub ExtractionLiensHypertextes()
Dim Cell As Range
'Boucle sur la plage A1 /A5
For Each Cell In Range("A1:A5")
If Cell.Hyperlinks.Count = 0 Then
MsgBox "je supprime"
End If
Next Cell
End Sub
ca me marque bien le message je supprime avec OK seulement rien ne ce passe
Merci d'avance pour vos retour.
j'espère que ce code te conviendra :
Sub ExtractionLiensHypertextes()
Dim Cell As Range
Dim ligne As Integer
ligne = 1
Dim ligne_a_effacer(100) As Integer 'variable tableau
'pour stocker les nuléros de lignes à supprimer
'Boucle sur la plage A1:A5
For Each Cell In Range("A1:A5")
If Cell.Hyperlinks.Count = 0 Then
ligne_a_effacer(ligne) = ligne
Else
ligne_a_effacer(ligne) = 0
End If
ligne = ligne + 1
Next Cell
'suppression des lignes
ligne = 1
For parcours = 1 To 100
If ligne_a_effacer(parcours) <> 0 Then
Rows(ligne).Delete
Else
ligne = ligne + 1
End If
Next parcours
End Sub
gullaud a écrit :j'espère que ce code te conviendra :
Sub ExtractionLiensHypertextes()
Dim Cell As Range
Dim ligne As Integer
ligne = 1
Dim ligne_a_effacer(100) As Integer 'variable tableau
'pour stocker les nuléros de lignes à supprimer
'Boucle sur la plage A1:A5
For Each Cell In Range("A1:A5")
If Cell.Hyperlinks.Count = 0 Then
ligne_a_effacer(ligne) = ligne
Else
ligne_a_effacer(ligne) = 0
End If
ligne = ligne + 1
Next Cell
'suppression des lignes
ligne = 1
For parcours = 1 To 100
If ligne_a_effacer(parcours) <> 0 Then
Rows(ligne).Delete
Else
ligne = ligne + 1
End If
Next parcours
End Sub
Bonjour gullaud,
ca à l'air de fonctionner mais il manque juste un petit détail c'est que mon tableau est plus grand que la ligne A1:A5
pour dire vrai sa serait A2 : A50 000, j'ai donc essayer de modifier par la suite For Each Cell In Range("A1:A5") par For Each Cell In Range("A1:A500") pour voir ce que cela donner mais la macro plante à la ligne ligne_a_effacer(ligne) = ligne
merci d'avance
essaye de replacer "integer" par "long"
Sub ExtractionLiensHypertextes()
Dim Cell As Range
Dim ligne As Long
ligne = 1
Dim ligne_a_effacer(100) As Long 'variable tableau
'pour stocker les numéros de lignes à supprimer
'Boucle sur la plage A2:A500
For Each Cell In Range("A2:A500")
If Cell.Hyperlinks.Count = 0 Then
ligne_a_effacer(ligne) = ligne
Else
ligne_a_effacer(ligne) = 0
End If
ligne = ligne + 1
Next Cell
'suppression des lignes
ligne = 1
For parcours = 1 To 100
If ligne_a_effacer(parcours) <> 0 Then
Rows(ligne).Delete
Else
ligne = ligne + 1
End If
Next parcours
End Sub
donc voila après essaie ca bug sur la ligne en rouge, j'ai l'impression en faite que du moment que j'entre autre choses que A1:A5 la macro ce met a buguer, une question que je me pose maintenant, est ce que ca change quelque chose si entre les cellule contenant des liens hypertexte, il y a des cellule vide ?
les nombre en vert correspondent il a entre eux ? est ce que a la place de 100 je doit rentrer la derniere celulle de mon tableur ?
Merci d'avance
j'ai trouver plus simple, mais il faut d'abord supprimer les lignes vides
Public Sub test()
Dim cell As Range
Dim i As Long
Feuil1.Select
i = 1
While Cells(i, 1) <> ""
x = Cells(i, 1)
Set cell = Cells(i, 1)
If cell.Hyperlinks.Count = 0 Then
Rows(i).Delete
Else
i = i + 1
End If
Wend
End Sub
gullaud a écrit :j'ai trouver plus simple, mais il faut d'abord supprimer les lignes vides
Public Sub test()
Dim cell As Range
Dim i As Long
Feuil1.Select
i = 1
While Cells(i, 1) <> ""
x = Cells(i, 1)
Set cell = Cells(i, 1)
If cell.Hyperlinks.Count = 0 Then
Rows(i).Delete
Else
i = i + 1
End If
Wend
End Sub
re gullaud,
alors avec ca ont touche au but car cela fait son travail, peut être un peut trop
comment faire maintenant pour que cette macro ne tienne pas compte de la première ligne ?
et aussi que doit on écrire a la place de "Feuil1.Select" ? car mon onglet à un nom personnaliser
Merci d'avance
remplacer au début de la procédure i=1 par i=2
feuil1.select par votrenom.select
attention
pour une feuille vous avez 2 noms nom de l'onglet nom de l'objet
1 : nom de l'onglet qui est en bas de la feuille de calcule
ex : azerty dans ce cas mettre sheets("azerty").select
2 :nom de l'objet feuille que l'on trouve dans le développeur visual basic
exemple : "donner" dans ce cas mettre : donner.select
je pense que pour vous la solution la plus simple est la 1
gullaud a écrit :remplacer au début de la procédure i=1 par i=2
feuil1.select par votrenom.select
attention
pour une feuille vous avez 2 noms nom de l'onglet nom de l'objet
1 : nom de l'onglet qui est en bas de la feuille de calcule
ex : azerty dans ce cas mettre sheets("azerty").select
2 :nom de l'objet feuille que l'on trouve dans le développeur visual basic
exemple : "donner" dans ce cas mettre : donner.select
je pense que pour vous la solution la plus simple est la 1
impeccable sa fonctionne
Bonne soirée
je passe le sujet en résolue