Eviter les IF END IF IF END IF

Le 04/12/2013 à 19:06

Bonsoir au forum,

Si je suis trop flou dite le moi et je mettrai en fichier associé à mon fichier excel contenant le tout.

Voici un bout de code que j'utilise dès que mon interface comporte des rangées de bouttons avec des actions

déterminés avec offset

Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)

Dim bouttons_groupe1 As Range, bouttons_groupe2 As Range

Set bouttons_groupe1 = Range("A1:A10")
Set bouttons_groupe2 = Range("A15:A25")
'set........ si il y d'autres groupes 

If Not Application.Intersect(target, Union(bouttons_groupe1, bouttons_groupe2)) Is Nothing Then

    If target.Offset(0, 10) = "" Then' si 10 cellules sur la droite est vide alors
        target.Offset(0, 10) = "J'écris 10 cellules à droite"
   Else 'sinon 
        target.Offset(0, 11) = "La cellule 10 n'était pas vide alors j'écris dans la 11"
    End If

End If

End Sub

Ca me permet de gagner du temps pour me positionner au lieu de faire comme il y a 3 semaines, If end range if 50 fois

Est-t'il possible d'appliquer la technique de l'offset dans le cas suivant ?

Sub todolist_button()
     If Range("E4").Value = "FEC" Then 'FEC veut dire Formation en cours
     With Sheets("FEC")
    i = .Cells(65535, 1).End(xlUp).Row
    Sheets("TODOLIST").Range("B4:O4").Copy
    .Cells(i + 1, 1).PasteSpecial Paste:=xlPasteValues
End With
End IF
End Sub

Telle que le code se présente il vérifie juste si FEC est bien dans la cellule E4 avant de copier B4:O4 dans la feuille FEC

Mais E4 peut contenir AEC affaire en cours, ou EEC Etude en cours, DM dossier médical et copier B4:04 non plus

dans FEC mais dans la feuille correspondante à son type d'action.

J'ai 5 autres actions comme celle là ce qui revient à 6X4 = 24 conditions et pour gagner du temps ayant besoin d'utiliser

mon todolist j'ai bêtement taper 24 conditions en VBA dans le boutons

si e4=FEC OU AEC ou EEC ou DM, vrai copy b4:O4 dans feuille correspondante

si e15=FEC OU AEC ou EEC ou DM, vrai copy b15:O15 dans feuille correspondante

si e26=FEC OU AEC ou EEC ou DM, vrai copy b26:O26 dans feuille correspondante

si e37=FEC OU AEC ou EEC ou DM, vrai copy b37:O37 dans feuille correspondante

Il doit y avoir plus court comme avec l'offset qui se positionne directement suivant la cellule correspondante

Si besoin : je copie le fichier ici, mais il est bourré de données perso que je vais devoir vider par pudeur.

Voici deux prints : FEC et TODOLIST pour imager l'interface qui communique avec les feullles FEC, AEC, EEC..

Cordialement

Variable

todo fec
Le 05/12/2013 à 02:01

Bonjour

Sans test car sans fichier

Si ce code est dans le module de la feuille "TODOLIST" on peut éviter de la nommer dans la macro

Sub todolist_button()
Dim Ligne As Long
Dim Derligne As Long

  Ligne = 4 ' ou 15 ou 26 ou 37
  With Sheets(Sheets("TODOLIST").Range("E" & Ligne).Value)
    Derligne = .Range("A" & Rows.Count).End(xlUp).Row + 1
    Sheets("TODOLIST").Range("B" & Ligne & ":O" & Ligne).Copy
    .Range("A" & Derligne).PasteSpecial Paste:=xlPasteValues
  End With
End Sub

Pour ta 1ère macro qui m'intrigue un peu

Essayes et dis moi ce qui se passe

Private Sub Worksheet_BeforeDoubleClick(ByVal target As Range, Cancel As Boolean)
'Dim bouttons_groupe1 As Range, bouttons_groupe2 As Range
'
'  Set bouttons_groupe1 = Range("A1:A10")
'  Set bouttons_groupe2 = Range("A15:A25")
'  'set........ si il y d'autres groupes
'
'  If Not Application.Intersect(target, Union(bouttons_groupe1, bouttons_groupe2)) Is Nothing Then
  If Not Application.Intersect(target, Range("A1:A10,A15:A25")) Is Nothing Then
    If target.Offset(0, 10) = "" Then ' si 10 cellules sur la droite est vide alors
      target.Offset(0, 10) = "J'écris 10 cellules à droite"
    Else 'sinon
      target.Offset(0, 11) = "La cellule 10 n'était pas vide alors j'écris dans la 11"
    End If
  End If
End Sub
Le 05/12/2013 à 12:15

Bonjour Banzai64

Je vais en soirée mettre le todolist en ligne une fois rentré des cours. En faite le problème est plus simple

il n'y a que le code du module qui pose problème en terme de nombre de ligne inutiles

voilà mon code du bouton

Ce bouton selon la classe d'un action en E(4,15,26..) envois vers 4 pages différentes : FEC ou EEC ou AEC ou DM

E est une liste de classes que je sélectionne suivant le contexte de mon action. Si c'est la vaisselle ben rien mais si je suis en train

de faire du marketing, mon action fait partie d'un suivit d'actions dans la feuille EEC (Etude en cours)

FEC // Feuille Formation en cours

EEC // Feuille Etude en cours

AEC // Feuille Affaire en cours

DM // Feuille (mon) Dossier médical

Donc en pro que je suis pour 5 lignes faisant pareil j'ai fait 20 conditions comme ceci dans le module :

Sub todolist_button()
   'si FEC dans E4 copie vers FEC 
    If Range("E4").Value = "FEC" Then 'FEC veut dire Formation en cours
    With Sheets("FEC")
    i = .Cells(65535, 1).End(xlUp).Row
    Sheets("TODOLIST").Range("B4:O4").Copy
    .Cells(i + 1, 1).PasteSpecial Paste:=xlPasteValues
    End With

End IF
   'si EEC dans E4 copie vers EEC
   If Range("E4").Value = "EEC" Then 'EEC veut dire feuille Etude en cours
    With Sheets("EEC")
    i = .Cells(65535, 1).End(xlUp).Row
    Sheets("TODOLIST").Range("B4:O4").Copy
    .Cells(i + 1, 1).PasteSpecial Paste:=xlPasteValues
    End With
   End IF
   'si AEC dans E4 copie vers AEC
   If Range("E4").Value = "AEC" Then 'Dossier médical
    With Sheets("AEC")
    i = .Cells(65535, 1).End(xlUp).Row
    Sheets("TODOLIST").Range("B4:O4").Copy
    .Cells(i + 1, 1).PasteSpecial Paste:=xlPasteValues
    End With
   End IF
   'si DM dans E4 copie vers DM
   If Range("E4").Value = "DM" Then 'Dossier médical
    With Sheets("DM")
    i = .Cells(65535, 1).End(xlUp).Row
    Sheets("TODOLIST").Range("B4:O4").Copy
    .Cells(i + 1, 1).PasteSpecial Paste:=xlPasteValues
    End With
   End IF

.................
Pareil pour pour La ligne 15, 26, 37 et 48  :mrgreen:  je suis un vrai pro du VB

   If Range("E15").Value = "FEC" Then 
    With Sheets("FEC")
    i = .Cells(65535, 1).End(xlUp).Row
    Sheets("TODOLIST").Range("B15:O15").Copy
    .Cells(i + 1, 1).PasteSpecial Paste:=xlPasteValues
    End With
   End IF
........
End Sub

J'ai fait ça 20 fois dans le module et je sais d'instinct que je me plante niveau syntaxe et alourdi tout le code pour rien.

Le premier code c'était juste pour voir offset ne pouvait pas faire tout cas en une seul boucle.

A ce soir, je vais vider le fichier et mettre le source ici ^^

Un grand merci

Variable

Le 05/12/2013 à 13:18

Bonjour

Le code que je t'ai fourni tu peux le mettre dans une boucle

Sub todolist_button()
Dim Ligne As Long
Dim Derligne As Long

  For Ligne = 4 To 37 Step 11    ' 4 15 26 37
   With Sheets(Sheets("TODOLIST").Range("E" & Ligne).Value)
      Derligne = .Range("A" & Rows.Count).End(xlUp).Row + 1
      Sheets("TODOLIST").Range("B" & Ligne & ":O" & Ligne).Copy
      .Range("A" & Derligne).PasteSpecial Paste:=xlPasteValues
    End With
  Next Ligne
End Sub

A voir avec ton fichier

Le 05/12/2013 à 20:32

Bonsoir Banzai64

Le fichier fonctionnelle est en attaché

Tu es un génie !

J'ai juste du mettre un on error resume car bien que ça plante ça marche.

Il envoi les lignes selon la classe d'action dans les cellules E dans les feuilles correspondantes 

For Ligne = 4 To 48 Step 11

ici Boucler de 4 à 48 en faisant un saut de 11 lignes (éviter les sous actions)

With Sheets(Sheets("TODOLIST").Range("E" & Ligne).Value)

c'est ici que j'ai halluciné ! C'est ultra propre et optimisé en une seule ligne !

Je suis incapable de produire un code aussi petit et propre un grand merci je vais étudier ca pour pouvoir au besoin l'adapter.

Variable

11myself-manager-forum.xlsm (94.33 Ko)
Le 05/12/2013 à 21:42

Bonjour

variable a écrit :

J'ai juste du mettre un on error resume car bien que ça plante ça marche.

Cela m'a intrigué : A cause des cellules vides en colonne E

Simplification : On ne nomme plus la feuille parce que le bouton est dans la feuille

A vérifier

Sub todolist_button()
Dim Ligne As Long
Dim Derligne As Long

  Application.ScreenUpdating = False
  For Ligne = 4 To 37 Step 11    ' 4 15 26 37
    If Range("E" & Ligne) <> "" Then
      With Sheets(Range("E" & Ligne).Value)
        Derligne = .Range("A" & Rows.Count).End(xlUp).Row + 1
        Range("B" & Ligne & ":O" & Ligne).Copy
        .Range("A" & Derligne).PasteSpecial Paste:=xlPasteValues
      End With
    End If
  Next Ligne
  Application.CutCopyMode = False
End Sub
Le 05/12/2013 à 22:21

WOW ca marche super bien.

Je ne sais pas quoi dire si ce n'est merci sincèrement pour ta patience et l'aide que tu m'a donné, je vais faire un grand bon en avant en étudiant la syntaxe maintenant.

Je joins l'autre fichier avec ton nouveau code pour ceux qui passerons par là au cas ou ils adapterons.

Variable

13myself-manager-forum2.xlsm (93.17 Ko)
Rechercher des sujets similaires à "eviter end"