Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel aide sur une macro (rep JaC)

aide sur une macro (rep JaC)

2 réponses
Avatar
alroussel
bonjour et tout d'abord merci pur t'être intéressé à mon cas.

En fonction de ta réponse, si je te suis bien, ma macro, fort longue,
devient:
- en faisant un seul sub et en remplacant les if et end if -

Sub programmation()
Dim Num
'création feuille programmation par copie de la liste dans une nouvelle
feuille
Sheets("Liste").Select
ActiveSheet.Copy After:= _
Workbooks("selection mcir.xls").Sheets(Workbooks("selection
mcir.xls").Sheets.Count)
Sheets("Liste (2)").Select
Sheets("liste (2)").Name = "Programmation"

'etablissement de la liste suivant le nombre de critère

' choix au moins x critères soit Num=x

Num = InputBox("Vous allez pouvoir établir une liste de personnes" _
& Chr(13) & "répondant au nombre minimun de critères" _
& Chr(13) & "que vous aurez choisi." _
& Chr(13) & Chr(13) & "INDIQUER CI-DESSOUS LE NOMBRE DE CRITERES" _
& Chr(13) & "( ce nombre peut varier de 1 à 10 )" _
& Chr(13) & Chr(13) & "Nombre de critères", "PROGRAMMATION")
'si pas de nombre
If Num = "" Then
MsgBox "aucun nombre n'a été indiqué." _
& Chr(13) & "Toute l'opération de programmation est" _
& Chr(13) & "annulée."
Sheets("programmation").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets("repertoire").Select
Range("e3").Select
Exit Sub
End If
'sélection suivant nombre indiqué
For Num= 1 to 10
call nombre(Num)
next
MsgBox "Voilà votre liste est établie" _
& Chr(13) & Chr(13) & "A VOUS DE JOUER !!!"
Sheets("repertoire").Select
Range("e3").Select
End Sub
----------------------------------------------------------------------------
-
Sub nombre(Num)
range(range("J1").offset(0,2*Num),Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
----------------------------------------------------------------------------
----------

mais voilà (je n'ai rien du comprendre) car lorque je répond pour Num = 2
par exemple, j'ai
un message d'erreur d'execution 1004 qui me dit " pas de cellules
correspondantes" et le débogage m'améne à la ligne de la macro Sub
nombre(Num) à la ligne range(range .....

Peus-tu m'aider

D'autre part, si je garde ma macro tel quel, en corrigeant simplement la
syntaxe suivant tes conseils, je reste toujours sur le m^me plantage
(impossible d'utiliser cette commande sur des sélections qui se
superposent)

merci d'avance

Alain
Sub nombre1()
With Range("L1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre2()
With Range("N1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre3()
With Range("P1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre4()
With Range("R1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre5()
With Range("T1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre6()
With Range("V1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre7()
With Range("X1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre8()
With Range("Z1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre9()
With Range("AB1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre10()
With Range("AD1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
Signaler un problème avec ce contenu

2 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
j
Sub nombre(Num)
range(range("J1").offset(0,2*Num),Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
--------------------------------------------------------------------------
--

----------

mais voilà (je n'ai rien du comprendre) car lorque je répond pour Num = 2
par exemple, j'ai
un message d'erreur d'execution 1004 qui me dit " pas de cellules
correspondantes" et le débogage m'améne à la ligne de la macro Sub
nombre(Num) à la ligne range(range .....


si pas de cellules correspondantes pour num=2, ça signifie probablement
qu'il n'y a pas de cellule vide (xlCellTypeBlanks) dans la plage qui part de
N1 et qui va à la dernière cellule occupée de la colonne A.
Si dans ce cas il suffit de ne pas supprimer de ligne tu dois pouvoir
utiliser on error resume next :

Sub nombre(Num)
on error resume next
range(range("J1").offset(0,2*Num),Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
on error goto 0
End Sub

Avatar
j
j'ai pu cerner un peu plus ton pb de sélection qui se superposent,
quand on met quelque chose en A2 par exemple et rien autre part et qu'on
écrit
Range("a1:d5").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
on a comme message
"impossible d'utiliser cette commande sur des sélections qui se superposent"

c'est marrant (oui, je sais, un rien m'amuse), j'avais jamais vu ça
le range à supprimer a l'air constitué d'une série de lignes dont plusieurs
fois les mêmes et excel ne s'y retrouve pas

ça ne te donne pas de solution...
à part balayer les lignes (ou les cellules) avec une boucle, je ne trouve
pas...
mais quelqu'une aura certainement une idée !



"alroussel" a écrit dans le message de news:
3fc0f8eb$0$2802$
bonjour et tout d'abord merci pur t'être intéressé à mon cas.

En fonction de ta réponse, si je te suis bien, ma macro, fort longue,
devient:
- en faisant un seul sub et en remplacant les if et end if -

Sub programmation()
Dim Num
'création feuille programmation par copie de la liste dans une nouvelle
feuille
Sheets("Liste").Select
ActiveSheet.Copy After:= _
Workbooks("selection mcir.xls").Sheets(Workbooks("selection
mcir.xls").Sheets.Count)
Sheets("Liste (2)").Select
Sheets("liste (2)").Name = "Programmation"

'etablissement de la liste suivant le nombre de critère

' choix au moins x critères soit Num=x

Num = InputBox("Vous allez pouvoir établir une liste de personnes" _
& Chr(13) & "répondant au nombre minimun de critères" _
& Chr(13) & "que vous aurez choisi." _
& Chr(13) & Chr(13) & "INDIQUER CI-DESSOUS LE NOMBRE DE CRITERES" _
& Chr(13) & "( ce nombre peut varier de 1 à 10 )" _
& Chr(13) & Chr(13) & "Nombre de critères", "PROGRAMMATION")
'si pas de nombre
If Num = "" Then
MsgBox "aucun nombre n'a été indiqué." _
& Chr(13) & "Toute l'opération de programmation est" _
& Chr(13) & "annulée."
Sheets("programmation").Select
Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets("repertoire").Select
Range("e3").Select
Exit Sub
End If
'sélection suivant nombre indiqué
For Num= 1 to 10
call nombre(Num)
next
MsgBox "Voilà votre liste est établie" _
& Chr(13) & Chr(13) & "A VOUS DE JOUER !!!"
Sheets("repertoire").Select
Range("e3").Select
End Sub
--------------------------------------------------------------------------
--

-
Sub nombre(Num)
range(range("J1").offset(0,2*Num),Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
--------------------------------------------------------------------------
--

----------

mais voilà (je n'ai rien du comprendre) car lorque je répond pour Num = 2
par exemple, j'ai
un message d'erreur d'execution 1004 qui me dit " pas de cellules
correspondantes" et le débogage m'améne à la ligne de la macro Sub
nombre(Num) à la ligne range(range .....

Peus-tu m'aider

D'autre part, si je garde ma macro tel quel, en corrigeant simplement la
syntaxe suivant tes conseils, je reste toujours sur le m^me plantage
(impossible d'utiliser cette commande sur des sélections qui se
superposent)

merci d'avance

Alain
Sub nombre1()
With Range("L1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre2()
With Range("N1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre3()
With Range("P1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre4()
With Range("R1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre5()
With Range("T1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre6()
With Range("V1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre7()
With Range("X1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre8()
With Range("Z1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre9()
With Range("AB1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

Sub nombre10()
With Range("AD1", Range("A65000").End(xlUp)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub