Optimisation simplification du code

Version imprimable

Bonjour,
Malgré le peu de connaissance que j'ai en VBA votre forum m'a ete d'une grand aide avec tous ces exemples et explications.
J'ai réussi a affiché dynamiquement des données mais je pense qu'il serais possible d’amélioré les syntaxes vu que je ne suis pas un pro
si vous pouvez y jeté un œil et me dire ce qu'il ne va pas

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
Sub Ajout()
        j = Application.CountA(Sheets("BD").Range("L:L"))
        ligne = 13
        l = (j + 13) - 2 'L sera la longueur du tableau j + 13 lignes (debut du tableau)
 
        For i = 2 To j 'i est debut colonne des dates
        colonne = 1
        'copie ligne Nom_BD vers planning
        Sheets("Planning").Range("A" & ligne).FormulaLocal = "=BD!" & Cells(i, 12).Address(True, True)
        'Sheets("Planning").Range("A" & ligne).Borders.Value = 1
        colonne = colonne + 1
        'burdure pour la liste de nom_bd
        Sheets("Planning").Cells(ligne, 1).Borders.Value = 1
 
            While colonne < 33 '33 derniere colonne jours
                If colonne <= 26 Then 'transformation colonne chiffre en charactere type A, B ... AA, AB
                x = Chr(64 + colonne)
                Else
                x = "A" + Chr(64 + (colonne - 26)) 'table de charactere ascii (chr)
                End If
                'ajout d'une formule avec des variables a chaque cellules du tableau
                Sheets("Planning").Cells(ligne, colonne).FormulaLocal = "=SI(SOMMEPROD((Noms=$A" & ligne & ")*(" & x & "$12>=Début)*(" & x & "$12<=Fin))>0;INDEX(Taches;SOMMEPROD((Noms=$A" & ligne & ")*(" & x & "$12>=Début)*(" & x & "$12<=Fin)*LIGNE(Noms))-1);"""")"
                Sheets("Planning").Cells(ligne, colonne).Borders.Value = 1
 
                    'si un nom de la liste sur la feuille BD a ete suprimer le tableau reactualise tout
                    'et supprime grace a la derniere valeur de L le contenue et la bordure
                    If Sheets("Planning").Range("A" & l + 1) = "" Then
                    Sheets("Planning").Cells(l + 1, colonne).FormulaLocal = ""
                    Sheets("Planning").Cells(l + 1, 1).Borders.Value = 0
                    Sheets("Planning").Cells(l + 1, colonne).Borders.Value = 0
                    End If
                colonne = colonne + 1
 
             Wend
 
        ligne = ligne + 1
 
        Sheets("Planning").Range("A" & l + 1).FormulaLocal = ""
 
        Next i
 
 
      End Sub

Par hasard

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
Sub Ajout()
Dim i As Long, N As Long, Ligne As Long
Dim Colonne As Integer
 
Application.ScreenUpdating = False
N = Application.CountA(Sheets("BD").Range("L:L"))
Ligne = 13
With Worksheets("Planning")
    For i = 2 To N                                    'i est debut colonne des dates
        With .Range("A" & Ligne)
            .Formula = "=BD!L" & i
            .Value = .Value
            .Borders.Value = 1
        End With
 
        With .Cells(Ligne, 2).Resize(, 32)
            .Formula = "=IF(SUMPRODUCT((Noms=$A" & Ligne & ")*(B$12>=Début)*(B$12<=Fin))>0,INDEX(Taches,SUMPRODUCT((Noms=$A" & Ligne & ")*(B$12>=Début)*(B$12<=Fin)*ROW(Noms))-1),"""")"
            .Value = .Value
            .Borders.Value = 1
        End With
        Ligne = Ligne + 1
    Next i
 
    If .Range("A" & Ligne) = "" Then
        With .Cells(Ligne, 2).Resize(, 32)
            .ClearContents
            .Borders.Value = 0
        End With
        .Cells(Ligne, 1).Borders.Value = 0
    End If
    .Range("A" & Ligne).ClearContents
End With
End Sub

Mille merci pour ton travail c'est énorme !
Le temps de calcule et d'affichage a était diviser par 3

j'ai appris encore des choses grace a tes corrections, mais il y a une chose que je n'est toujours pas compris
Comment la valeur B$12 peut elle changer en C$12 D$12 ... grace a .Cells(Ligne, 2).Resize(, 32) pour la formule?

Code:

=IF(SUMPRODUCT((Noms=$A" & Ligne & ")*(B$12>=Début)*(B$12<=Fin))>0,INDEX(Taches,SUMPRODUCT((Noms=$A" & Ligne & ")*(B$12>=Début)*(B$12<=Fin)*ROW(Noms))-1),"""")

j'ai supprimer .Value = .Value car j'ai besoin de la formule dont la variable B$12 change de valeur (date) grâce a une barre de défilement comme cela chaque cellule affichera en fonction d'une date une valeur différente

Ton code d'origine ne fonctionner pas

Code:

1
2
3
4
5
6
7
If .Range("A" & Ligne) = "" Then
        With .Cells(Ligne, 2).Resize(, 32)
            .ClearContents
            .Borders.Value = 0
        End With
        .Cells(Ligne, 1).Borders.Value = 0
    End If

j'ai juste inverser le With avec le If pour que cela fonctionne

Code:

1
2
3
4
5
6
7
8
9
 With .Cells(Ligne, 2).Resize(, 32)
 If .Range("A" & Ligne) = "" Then
 
            .ClearContents
            .Borders.Value = 0
 
        .Cells(Ligne, 1).Borders.Value = 0
    End If
    End With

Une fois modifier voila ce que cela donne:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
Sub Ajout()
Dim i As Long, N As Long, Ligne As Long
Dim Colonne As Integer
 
Application.ScreenUpdating = False
N = Application.CountA(Sheets("BD").Range("L:L"))
Ligne = 13
With Worksheets("Planning")
    For i = 2 To N                                    'i est debut colonne des dates
        With .Range("A" & Ligne)
            .Formula = "=BD!L" & i
            .Value = .Value
            .Borders.Value = 1
        End With
 
        With .Cells(Ligne, 2).Resize(, 32)
            .Formula = "=IF(SUMPRODUCT((Noms=$A" & Ligne & ")*(B$12>=Début)*(B$12<=Fin))>0,INDEX(Taches,SUMPRODUCT((Noms=$A" & Ligne & ")*(B$12>=Début)*(B$12<=Fin)*ROW(Noms))-1),"""")"
            '.Value = .Value je l'ai supprimer 
            .Borders.Value = 1
        End With
        Ligne = Ligne + 1
    Next i
 
    With .Cells(Ligne, 2).Resize(, 32) 'ton code d'origine ne fonctionner pas j'ai juste inverser le With avec le If pour que cela fonctionne 
 If .Range("A" & Ligne) = "" Then
 
            .ClearContents
            .Borders.Value = 0
 
        .Cells(Ligne, 1).Borders.Value = 0
    End If
    End With
 
    .Range("A" & Ligne).Borders.Value = 0 'je l'ai rajouter pour mes besoins
    .Range("A" & Ligne).ClearContents
End With
End Sub

Encore merci
trop fort !
j'avais pas mal bidouiller, mais la c'est propre !!!

24/03/2015, 20h49
mercatog

Pour ta première question, c'est comme si on écrit une formule dans une cellule et on la tire vers le bas ou vers la droite par exemple. Les références relatives changent et celles absolues restent figées.

Pour ton second changement, il faudra au moins savoir que veux tu faire. Par tâtonnement tu as inversé les with mais pourquoi. Si tu explique clairement ce que doit faire cette partie, on fera quelque chose de potable.

PS. Une remarque, tu peux t'en passer de la variable Ligne et la remplacer par i+11
26/03/2015, 19h44
chunisy

Dans la seconde modification mon but est d’effacer une ligne de tableau si dans la cellule (variable) de la première colonne A (soit A13, A14, A15 ...) contient "" (vide).

en tout cas merci pour ces précisions j'ai une meilleur compréhension de ce que vous avez fait