Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

simplifié une macro

B

beatrice2fr

XLDnaute Nouveau
bonjour
je voudrai savoir si la macro suivante peut etre simplifié car la procedure prend environ 10 bonnes secondes.....

j'explique un peu . vba examine le contenue de 2 cellules dans 2 feuilles differentes ( ce qui correspond a un repere ) et renvoie un msgbox pour chaque repere, si les conditions sont remplies. Est il possible que vba examine et ne renvoie qu'un seul message regroupant tous les reperes; du genre
"REP 1 /3 / 6 / 8 : VOIR GRANDE LONGEUR"


Code: 
Private Sub Worksheet_Activate()

Application.ScreenUpdating = False
On Error Resume Next

' premiere partie

If Sheets("CLOTURE").[D15] <> "" And Sheets("RC").[C4] = "" Then
MsgBox ("REP 1 : VOIR GRANDE LONGEUR")
End If

If Sheets("CLOTURE").[D16] <> "" And Sheets("RC").[I4] = "" Then
MsgBox ("REP 2 : VOIR GRANDE LONGEUR")
End If

If Sheets("CLOTURE").[D17] <> "" And Sheets("RC").[O4] = "" Then
MsgBox ("REP 3 : VOIR GRANDE LONGEUR")
End If

If Sheets("CLOTURE").[D18] <> "" And Sheets("RC").[U4] = "" Then
MsgBox ("REP 4 : VOIR GRANDE LONGEUR")
End If

If Sheets("CLOTURE").[D19] <> "" And Sheets("RC").[AA4] = "" Then
MsgBox ("REP 5 : VOIR GRANDE LONGEUR")
End If

If Sheets("CLOTURE").[D20] <> "" And Sheets("RC").[C26] = "" Then
MsgBox ("REP 6 : VOIR GRANDE LONGEUR")
End If

If Sheets("CLOTURE").[D21] <> "" And Sheets("RC").[I26] = "" Then
MsgBox ("REP 7 : VOIR GRANDE LONGEUR")
End If

If Sheets("CLOTURE").[D22] <> "" And Sheets("RC").[O26] = "" Then
MsgBox ("REP 8 : VOIR GRANDE LONGEUR")
End If

If Sheets("CLOTURE").[D23] <> "" And Sheets("RC").[U26] = "" Then
MsgBox ("REP 9 : VOIR GRANDE LONGEUR")
End If

If Sheets("CLOTURE").[D24] <> "" And Sheets("RC").[AA26] = "" Then
MsgBox ("REP 10 : VOIR GRANDE LONGEUR")
End If

If Sheets("CLOTURE").[D25] <> "" And Sheets("RC").[C48] = "" Then
MsgBox ("REP 11 : VOIR GRANDE LONGEUR")
End If

If Sheets("CLOTURE").[D26] <> "" And Sheets("RC").[I48] = "" Then
MsgBox ("REP 12 : VOIR GRANDE LONGEUR")
End If

If Sheets("CLOTURE").[D27] <> "" And Sheets("RC").[O48] = "" Then
MsgBox ("REP 13 : VOIR GRANDE LONGEUR")
End If

If Sheets("CLOTURE").[D28] <> "" And Sheets("RC").[U48] = "" Then
MsgBox ("REP 14 : VOIR GRANDE LONGEUR")
End If

If Sheets("CLOTURE").[D29] <> "" And Sheets("RC").[AA48] = "" Then
MsgBox ("REP 15 : VOIR GRANDE LONGEUR")
End If

' deuxieme partie
' procedure de valeur cible , mais la je ne pense pas que l'on puisse simplifié....
    Sheets("WCL").[A9] = ""
    Sheets("WCL").[V6].GoalSeek Goal:=Sheets("WCL").[W6], ChangingCell:=Sheets("WCL").[A9]
    Sheets("WCL").[A70] = ""
    Sheets("WCL").[V67].GoalSeek Goal:=Sheets("WCL").[W67], ChangingCell:=Sheets("WCL").[A70]
    Sheets("WCL").[A132] = ""
    Sheets("WCL").[V129].GoalSeek Goal:=Sheets("WCL").[W129], ChangingCell:=Sheets("WCL").[A132]
    Sheets("WCL").[A194] = ""
    Sheets("WCL").[V191].GoalSeek Goal:=Sheets("WCL").[W191], ChangingCell:=Sheets("WCL").[A194]
    Sheets("WCL").[A256] = ""
    Sheets("WCL").[V253].GoalSeek Goal:=Sheets("WCL").[W253], ChangingCell:=Sheets("WCL").[A256]
    Sheets("WCL").[A318] = ""
    Sheets("WCL").[V315].GoalSeek Goal:=Sheets("WCL").[W315], ChangingCell:=Sheets("WCL").[A318]
    Sheets("WCL").[A344] = ""
    Sheets("WCL").[V341].GoalSeek Goal:=Sheets("WCL").[W341], ChangingCell:=Sheets("WCL").[A344]
    Sheets("WCL").[A371] = ""
    Sheets("WCL").[V368].GoalSeek Goal:=Sheets("WCL").[W368], ChangingCell:=Sheets("WCL").[A371]
    Sheets("WCL").[A397] = ""
    Sheets("WCL").[V394].GoalSeek Goal:=Sheets("WCL").[W394], ChangingCell:=Sheets("WCL").[A397]
    Sheets("WCL").[A423] = ""
    Sheets("WCL").[V420].GoalSeek Goal:=Sheets("WCL").[W420], ChangingCell:=Sheets("WCL").[A423]
    Sheets("WCL").[A449] = ""
    Sheets("WCL").[V446].GoalSeek Goal:=Sheets("WCL").[W446], ChangingCell:=Sheets("WCL").[A449]
    Sheets("WCL").[A475] = ""
    Sheets("WCL").[V472].GoalSeek Goal:=Sheets("WCL").[W472], ChangingCell:=Sheets("WCL").[A475]
    Sheets("WCL").[A501] = ""
    Sheets("WCL").[V498].GoalSeek Goal:=Sheets("WCL").[W498], ChangingCell:=Sheets("WCL").[A501]
    Sheets("WCL").[A527] = ""
    Sheets("WCL").[V524].GoalSeek Goal:=Sheets("WCL").[W524], ChangingCell:=Sheets("WCL").[A527]
    Sheets("WCL").[A553] = ""
    Sheets("WCL").[V550].GoalSeek Goal:=Sheets("WCL").[W550], ChangingCell:=Sheets("WCL").[A553]

Application.ScreenUpdating = True
On Error GoTo 0
End Sub
 
Trier par date Trier par votes

pierrejean

XLDnaute Barbatruc
Re : simplifié une macro

bonjour beatrice

Pour la 1ere partie

Code: 
Adresses = Array("C4", "I4", "O4", "U4", "AA4", "C26", "I26", "O26", "U26", "AA26", "C248", "I48", "O48", "U48", "AA48")
For n = 15 To 29
 If Sheets("CLOTURE").Range("D" & n) <> "" And Sheets("RC").Range(Adresses(n - 15)) = "" Then
   liste = liste & "REP " & n - 14 & " et "
 End If
Next n
liste = Left(liste, Len(liste) - 3) & ": VOIR GRANDE LONGEUR"
MsgBox (liste)

La 2eme partie peut etre traitée sur le même modèle
Je te laisse essayer et si tu n'y arrive pas reviens
 
Vote positif 0 Vote négatif
B

beatrice2fr

XLDnaute Nouveau
Re : simplifié une macro

merci de ta reponse, et c'est bien ce que je cherche a faire. Toutefois j'ai , entretemps, essayer d'avancer par moi meme, et de ce fait j'ai un peu modifier les données ( ex. une seule cellule a examiner) . Et j'ai beau essayer je ne parviens pas a adapter ta procedure correctement.
je joins un exemple pour plus de clareté .
 

Pièces jointes

  • exemple1.xls
    15.5 KB · Affichages: 44
  • exemple1.xls
    15.5 KB · Affichages: 53
  • exemple1.xls
    15.5 KB · Affichages: 48
Vote positif 0 Vote négatif

bqtr

XLDnaute Accro
Re : simplifié une macro

Bonsoir beatrice
Bonsoir pierrejean

Essaye ceci :

Code: 
Sub ListeRep()

Dim k As Byte, List As String

With Sheets("CLOTURE")
  For k = 7 To 14
    If .Cells(k, 7) <> "" Then List = List & .Cells(k, 7) & " - "
  Next
End With
 
If List <> "" Then MsgBox "REP " & Left(List, Len(List) - 2) & " : VOIR GRANDE LONGUEUR", vbInformation, "Résultat REP :"

End Sub

A+
 
Vote positif 0 Vote négatif
B

beatrice2fr

XLDnaute Nouveau
Re : simplifié une macro

j'ai constater que c'est uniquement la partie valeur cible qui prend du temps,
alors je vous solliciterai encore pour un moyen d'accelerer le processus

Code: 
Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
On Error Resume Next
Dim k As Byte, List As String

With Sheets("WCL")
  For k = 7 To 14
    If .Cells(k, 79) <> "" Then List = List & .Cells(k, 79) & " - "
  Next
End With
 
If List <> "" Then MsgBox "REP " & Left(List, Len(List) - 2) & " : VOIR GRANDE LONGUEUR", vbInformation, "RESULTAT REP :"


'Deuxieme partie   Valeur cible

   
    Sheets("WCL").[V6].GoalSeek Goal:=Sheets("WCL").[W6], ChangingCell:=Sheets("WCL").[A9]
    Sheets("WCL").[V67].GoalSeek Goal:=Sheets("WCL").[W67], ChangingCell:=Sheets("WCL").[A70]
    Sheets("WCL").[V129].GoalSeek Goal:=Sheets("WCL").[W129], ChangingCell:=Sheets("WCL").[A132]
    Sheets("WCL").[V191].GoalSeek Goal:=Sheets("WCL").[W191], ChangingCell:=Sheets("WCL").[A194]
    Sheets("WCL").[V253].GoalSeek Goal:=Sheets("WCL").[W253], ChangingCell:=Sheets("WCL").[A256]
    Sheets("WCL").[V315].GoalSeek Goal:=Sheets("WCL").[W315], ChangingCell:=Sheets("WCL").[A318]
    Sheets("WCL").[V341].GoalSeek Goal:=Sheets("WCL").[W341], ChangingCell:=Sheets("WCL").[A344]
    Sheets("WCL").[V368].GoalSeek Goal:=Sheets("WCL").[W368], ChangingCell:=Sheets("WCL").[A371]
    Sheets("WCL").[V394].GoalSeek Goal:=Sheets("WCL").[W394], ChangingCell:=Sheets("WCL").[A397]
    Sheets("WCL").[V420].GoalSeek Goal:=Sheets("WCL").[W420], ChangingCell:=Sheets("WCL").[A423]
    Sheets("WCL").[V446].GoalSeek Goal:=Sheets("WCL").[W446], ChangingCell:=Sheets("WCL").[A449]
    Sheets("WCL").[V472].GoalSeek Goal:=Sheets("WCL").[W472], ChangingCell:=Sheets("WCL").[A475]
    Sheets("WCL").[V498].GoalSeek Goal:=Sheets("WCL").[W498], ChangingCell:=Sheets("WCL").[A501]
    Sheets("WCL").[V524].GoalSeek Goal:=Sheets("WCL").[W524], ChangingCell:=Sheets("WCL").[A527]
    Sheets("WCL").[V550].GoalSeek Goal:=Sheets("WCL").[W550], ChangingCell:=Sheets("WCL").[A553]
Application.ScreenUpdating = True
On Error GoTo 0
End Sub
 
Vote positif 0 Vote négatif

pierrejean

XLDnaute Barbatruc
Re : simplifié une macro

Re

Salut Pierre Olivier

A tester:
Code: 
[COLOR=blue]Application.Calculation = xlCalculationManual[/COLOR]
Sheets("WCL").[V6].GoalSeek Goal:=Sheets("WCL").[W6], ChangingCell:=Sheets("WCL").[A9]
Sheets("WCL").[V67].GoalSeek Goal:=Sheets("WCL").[W67], ChangingCell:=Sheets("WCL").[A70]
Sheets("WCL").[V129].GoalSeek Goal:=Sheets("WCL").[W129], ChangingCell:=Sheets("WCL").[A132]
Sheets("WCL").[V191].GoalSeek Goal:=Sheets("WCL").[W191], ChangingCell:=Sheets("WCL").[A194]
Sheets("WCL").[V253].GoalSeek Goal:=Sheets("WCL").[W253], ChangingCell:=Sheets("WCL").[A256]
Sheets("WCL").[V315].GoalSeek Goal:=Sheets("WCL").[W315], ChangingCell:=Sheets("WCL").[A318]
Sheets("WCL").[V341].GoalSeek Goal:=Sheets("WCL").[W341], ChangingCell:=Sheets("WCL").[A344]
Sheets("WCL").[V368].GoalSeek Goal:=Sheets("WCL").[W368], ChangingCell:=Sheets("WCL").[A371]
Sheets("WCL").[V394].GoalSeek Goal:=Sheets("WCL").[W394], ChangingCell:=Sheets("WCL").[A397]
Sheets("WCL").[V420].GoalSeek Goal:=Sheets("WCL").[W420], ChangingCell:=Sheets("WCL").[A423]
Sheets("WCL").[V446].GoalSeek Goal:=Sheets("WCL").[W446], ChangingCell:=Sheets("WCL").[A449]
Sheets("WCL").[V472].GoalSeek Goal:=Sheets("WCL").[W472], ChangingCell:=Sheets("WCL").[A475]
Sheets("WCL").[V498].GoalSeek Goal:=Sheets("WCL").[W498], ChangingCell:=Sheets("WCL").[A501]
Sheets("WCL").[V524].GoalSeek Goal:=Sheets("WCL").[W524], ChangingCell:=Sheets("WCL").[A527]
[COLOR=blue]Application.Calculation = xlCalculationAutomatic[/COLOR]
[COLOR=#0000ff][/COLOR]
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.

Discussions similaires

M
  • Question
Microsoft 365 Macro VBA supprimer une colonne
Réponses
5
Affichages
139
marie3107
M
  • Résolu(e)
XL 2021 recherche supprimer les espaces '"si valeur cherchée est numérique" sinon NON
Réponses
7
Affichages
348
Usine à gaz
H
  • Question
Microsoft 365 Besoin aide : Erreur code macro . Problème est résolu
Réponses
7
Affichages
671
heart clean
H
E
  • Résolu(e)
Microsoft 365 Boucle sur lignes <>0
Réponses
2
Affichages
172
eric72
E
  • Résolu(e)
Microsoft 365 Exporter une feuille en valeur - sans les formules matricielles
Réponses
10
Affichages
426
Gen Rose
  • Résolu(e)
Autres InputBox
Réponses
8
Affichages
528
dysorthographie
G
  • Question
Microsoft 365 Réduire la taille de la macro ?
Réponses
9
Affichages
644
Staple1600
K
  • Question
Microsoft 365 Activation d'onglet en rapport avec l'encodage dans une ligne
Réponses
1
Affichages
375
eCHO
E
S
  • Question
XL 2019 Macro VBA enregistrement pdf plusieurs onglets dans un sens précis
Réponses
11
Affichages
1 K
sofmat
S
  • Question
Microsoft 365 simuler clic sur un bouton macro
Réponses
12
Affichages
951
Usine à gaz
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…