For Each et créer un pas de copier de formule

**GADENSEB** · 11/08/2017, 11h27

Bonjour le Forum

Je cherche à créer une boucle pour remplir un tableau
La recherche est sur la Colonne A et la première Cellule à remplir est en colonne F --> + 5
Puis on remplir 12 colonnes puis on saute 2 colonnes, puis rebelotte 12 colonnes ......

La dernière série de 12 colonnes à remplir commence en DN et se termine en DY

J'en suis là :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private Sub Worksheet_Activate()
With Sheets("SYNTHESE")
'----------------------------
Dim LigneCalcul
For Each LigneCalcul In Range("A15:A650")
If LigneCalcul <> "" Then
 
  Range(LigneCalcul.Offset(0, 5), LigneCalcul.Offset(0, 12)).FormulaR1C1 = "=SUMPRODUCT((R1C<=Mois_Reporting)*(Tb_B_COMPTE=RC1)*(Tb_B_ANNEE=YEAR(R7C))*(Tb_B_MOIS=R2C)*(Tb_B_BUDGETREEL=RC4)*(Tb_B_POSTE=RC2)*(Tb_B_BQ=""OUI"")*(Tb_B_DEBITCREDIT))"
 Range(LigneCalcul.Offset(0, 5), LigneCalcul.Offset(0, 12)).Value = Range(LigneCalcul.Offset(0, 5), LigneCalcul.Offset(0, 12)).Value
 end if
 Next LigneCalcul
'----------------------------
End With
End Sub

du coup il me manque la colonne max et le Pas de2.

qqn aurait une idée de comment les intégrer ?

Merci à vous

**riaolle** · 11/08/2017, 13h29

Bonjour,
Plutôt que d'utiliser la boucle For Each, utilise la boucle For. Tu remplis 12 colonnes toutes les 14 colonnes.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Worksheet_Activate()
Dim col As Long
With Sheets("SYNTHESE")
'----------------------------
   For col = 1 To 118 Step 14      'DN = 118
 
        Range(Cells(15, col), Cells(650, col + 12)).FormulaR1C1 = "=SUMPRODUCT((R1C<=Mois_Reporting)*(Tb_B_COMPTE=RC1)*(Tb_B_ANNEE=YEAR(R7C))*(Tb_B_MOIS=R2C)*     (Tb_B_BUDGETREEL=RC4)*(Tb_B_POSTE=RC2)*(Tb_B_BQ=""OUI"")*(Tb_B_DEBITCREDIT))"
        Range(LigneCalcul.Offset(0, 5), LigneCalcul.Offset(0, 12)).Value = Range(LigneCalcul.Offset(0, 5), LigneCalcul.Offset(0, 12)).Value
 
   Next col
'----------------------------
End With
End Sub

Attention à la syntaxe du bloc With :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
With Sheets("maFeuille")
    .Range("A1").Value = "toto"
End With

**GADENSEB** · 11/08/2017, 14h24

Envoyé par riaolle

Bonjour,
Plutôt que d'utiliser la boucle For Each, utilise la boucle For. Tu remplis 12 colonnes toutes les 14 colonnes.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Worksheet_Activate()
Dim col As Long
With Sheets("SYNTHESE")
'----------------------------
   For col = 1 To 118 Step 14      'DN = 118
 
        Range(Cells(15, col), Cells(650, col + 12)).FormulaR1C1 = "=SUMPRODUCT((R1C<=Mois_Reporting)*(Tb_B_COMPTE=RC1)*(Tb_B_ANNEE=YEAR(R7C))*(Tb_B_MOIS=R2C)*     (Tb_B_BUDGETREEL=RC4)*(Tb_B_POSTE=RC2)*(Tb_B_BQ=""OUI"")*(Tb_B_DEBITCREDIT))"
        Range(LigneCalcul.Offset(0, 5), LigneCalcul.Offset(0, 12)).Value = Range(LigneCalcul.Offset(0, 5), LigneCalcul.Offset(0, 12)).Value
 
   Next col
'----------------------------
End With
End Sub

Attention à la syntaxe du bloc With :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
With Sheets("maFeuille")
    .Range("A1").Value = "toto"
End With

Hello
Cela m'a l'air bien
je vais testé mais il manque la référence à la colonne A
Si Col A <> "" then ......
et du coup ?
comment copier / coller les valeurs

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range(LigneCalcul.Offset(0, 5), LigneCalcul.Offset(0, 12)).Value = Range(LigneCalcul.Offset(0, 5), LigneCalcul.Offset(0, 12)).Value

ne marche que pour les 12 première colonnes ;-)
on doit jouer avec ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range(Cells(15, col), Cells(650, col + 12))

**riaolle** · 11/08/2017, 14h38

Envoyé par GADENSEB

je vais testé mais il manque la référence à la colonne A
Si Col A <> "" then ......

Qu'est-ce que cela signifie ? Pour une ligne donnée, tu veux écrire la formule seulement si la cellule de la ligne en colonne A est non vide ? Est-ce parce que ta formule renvoie une erreur si c'est le cas ? Si oui, tu devrais plutôt ajouter une condition dans ta formule (IFERROR). Tu comprends ?
Si c'est pour une autre raison, il faudra faire une boucle imbriquée dans la boucle des colonnes.

comment copier / coller les valeurs

Ah oui, désolée, j'ai pas adapté la ligne. Mais c'est sur le même principe :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range(Cells(15, col), Cells(650, col + 12)).Value = Range(Cells(15, col), Cells(650, col + 12)).Value

Est-ce que tu comprends bien la syntaxe ?

**GADENSEB** · 11/08/2017, 14h42

yes je comprends

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range(Cells(15, col), Cells(650, col + 12)).Value = Range(Cells(15, col), Cells(650, col + 12)).Value

C'est ce que je pensais !

Pour une ligne donnée, tu veux écrire la formule seulement si la cellule de la ligne en colonne A est non vide ?

Oui en fait j'ai un tableau avec des cases bien précises à remplir 12 colonnes ....
mais je ne veu remplir que celle dont il ya une info en colonne A

C'est pour cela que j'avais mis

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
For Each LigneCalcul In Range("A15:A650")
If LigneCalcul <> "" Then.......

**riaolle** · 11/08/2017, 14h51

OK. On pourrait passer par une boucle imbriquée : pour chaque set de colonne, on ferait une boucle sur les ligne pour vérifier que la colonne A n'est pas vide. Mais ça va être long de faire une boucle. Alors pour faire une programme plus efficace, on va utiliser les filtres. Pour cela, il faut que tu aies des en-têtes en ligne 1.

Tu mets la formule partout (code que je t'ai donné)
Tu filtres en colonne A sur les cellules vides (pour filtrer : AutoFilter)
Tu effaces le contenu de toutes les cellules (résultantes du filtre)
Tu enlèves le filtre (toujours AutoFilter, mais cette fois-ci sans critère)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Private Sub Worksheet_Activate()
Dim col As Long
With Sheets("SYNTHESE")
'----------------------------
   For col = 1 To 118 Step 14      'DN = 118
 
        .Range(Cells(15, col), Cells(650, col + 12)).FormulaR1C1 = "=SUMPRODUCT((R1C<=Mois_Reporting)*(Tb_B_COMPTE=RC1)*(Tb_B_ANNEE=YEAR(R7C))*(Tb_B_MOIS=R2C)*     (Tb_B_BUDGETREEL=RC4)*(Tb_B_POSTE=RC2)*(Tb_B_BQ=""OUI"")*(Tb_B_DEBITCREDIT))"
   Next col
    .Range("A1:DN650")Value = .Range("A1:DN650").Value
 
'1. Autofilter
'2. Effacer les cellules
    .Range("A2:DN650").ClearContents
'3. Enlever le filtre
End With
End Sub

Au passage tu remarques que j'ai mis le Range(..).Value = Range(...).Value en dehors de la boucle pour tout faire d'un coup à la fin.

**GADENSEB** · 11/08/2017, 15h03

thanks
Le pb c'est que je n'ai pas d'en-tete en colonne A
C'est vide jusqu'a la ligne 15
Du coup, la boucle serait plus adaptée non?

je viens de me rendre compte
on commence en colonne F les calculs donc

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For col = 1 To 118 Step 14      'DN = 118

doit être

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For col = 6 To 118 Step 14      'DN = 118

Non ?

**riaolle** · 11/08/2017, 15h12

Oui, c'est ça pour la colonne F.
Ah, si les cellules sont vides jusqu'en ligne 15, c'est bon aussi. En gros, il te faut juste une ligne qui ne soit pas triée.
Tu pourras utiliser AutoFilter de la façon suivante :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Range("A15:DN650").AutoFilter Field:=1, Criteria1:=""

Puis pour enlever le filtre à la fin :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

.Range("A15:DN650").AutoFilter Field:=1

**GADENSEB** · 11/08/2017, 16h35

J'ai essayé la méthode avec la boucle

heuuuuu 25 minutes de temps de traitement ..... c'est long lol

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub synthesedonnées()
 
 
Dim col As Long
With Sheets("SYNTHESE")
 
Dim LigneCalcul
For Each LigneCalcul In Range("A15:A650")
If LigneCalcul <> "" Then
'----------------------------
   For col = 6 To 118 Step 14      'DN = 118
 .Range(Cells(15, col), Cells(650, col + 12)).Value = Range(Cells(15, col), Cells(650, col + 12)).Value
.Range(Cells(15, col), Cells(650, col + 12)).FormulaR1C1 = _
    "=SUMPRODUCT((R1C<=Mois_Reporting)*(Tb_B_COMPTE=RC1)*(Tb_B_ANNEE=YEAR(R7C))*(Tb_B_MOIS=R2C)*(Tb_B_BUDGETREEL=RC4)*(Tb_B_POSTE=RC2)*(Tb_B_BQ=""OUI"")*(Tb_B_DEBITCREDIT))"
.Range(Cells(15, col), Cells(650, col + 12)).Value = Range(Cells(15, col), Cells(650, col + 12)).Value
  Next col
 
End If
 Next LigneCalcul
 
 
End With
 
 
 
 
 
End Sub

J'ai trouvé pkoi c'est long
il fait parfaitement le calcul, et recopie les formules dans les celllules mai au lieu de copier/coller les valeurs à chaque itération
le code laisse les toutes les formules puis à la fin copie/colle valeur
d'ou la lenteur puisque les sommeprod s'éxécute en permanence. .....

comment tricher en passant par une variable? qui prend le résultat de la formule et s'est ce résultat que le l'on copie /colle ?

**riaolle** · 14/08/2017, 08h18

Attention, si tu fais une double boucle, il faut utiliser les 2 indices. Ici, tu fais une boucle sur les lignes, dans cette boucle tu fais une boucle sur les colonnes. Pour chaque iteration de la boucle sur les colonnes, tu fais le calcul pour toutes les lignes de 15 à 650.
Donc tu annihiles la condition colonne A <> vide et tu fais 635 fois les mêmes calculs (ce qui peut expliquer la lenteur ...) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub synthesedonnées()
Dim col As Long
Dim LigneCalcul As Long
With Sheets("SYNTHESE")
For LigneCalcul = 15 To 650
    If .Range("A" & LigneCalcul) <> "" Then
'----------------------------
       For col = 6 To 118 Step 14      'DN = 118
           .Range(Cells(15, col), Cells(650, col + 12)).FormulaR1C1 = _
                "=SUMPRODUCT((R1C<=Mois_Reporting)*(Tb_B_COMPTE=RC1)*(Tb_B_ANNEE=YEAR(R7C))*(Tb_B_MOIS=R2C)*(Tb_B_BUDGETREEL=RC4)*(Tb_B_POSTE=RC2)*(Tb_B_BQ=""OUI"")*(Tb_B_DEBITCREDIT))"
          .Range(Cells(LigneCalcul, col), Cells(LigneCalcul, col + 12)).Value = .Range(Cells(LigneCalcul, col), Cells(LigneCalcul, col + 12)).Value
       Next col
    End If
Next LigneCalcul
End With 
End Sub

**GADENSEB** · 14/08/2017, 08h24

Ok ok
Je comprends mieux.... J'ai pas accès à mon pc ce matin.
Je teste cela demain.

Merci à toi

**GADENSEB** · 15/08/2017, 21h30

Hello
Je viens de tester ton code,
très bien écris, thanks.
Le probleme reste le mm
le code installe bien les formules

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
  .Range(Cells(15, col), Cells(650, col + 12)).FormulaR1C1 = _
                "=SUMPRODUCT((R1C<=Mois_Reporting)*(Tb_B_COMPTE=RC1)*(Tb_B_ANNEE=YEAR(R7C))*(Tb_B_MOIS=R2C)*(Tb_B_BUDGETREEL=RC4)*(Tb_B_POSTE=RC2)*(Tb_B_BQ=""OUI"")*(Tb_B_DEBITCREDIT))"

mais en bloc sur toutes les colonnes
et non pas cellules par cellules.
Le but serait de faire le calcul sur une cellule cible puis d'en coller le résultat (ne pas inscrire la formule) et de passer à la cellule suivante.....etc....

qu'est ce que tu en penses ?

**GADENSEB** · 16/08/2017, 09h59

hello
J'ai bossé sur le truc

- j'ai mis col+11 car au total on veut inscrire sur 12 colonnes, donc 11 aprés la premiére
- le filtrage sur If .Range("A" & LigneCalcul) <> "" ne fonctionne pas le code inscrit par bloc de 15 à 30, j'ai essayé en en inversant la boucle et le If mais cela ne change rien
- J'ai installer un compteur, et en n'allant que jusqu’à la ligne 30 j'ai 144 calculs
Le reste marche nikel :-)

voici le nouveau code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub synthesedonnées()
Dim col As Long
Dim LigneCalcul As Long
Dim Compteur As Integer
 
With Sheets("SYNTHESE")
For LigneCalcul = 15 To 30
 
 
   For col = 6 To 118 Step 14      'DN = 118
 
     If .Range("A" & LigneCalcul) <> "" Then
          .Range(Cells(15, col), Cells(30, col + 11)).FormulaR1C1 = _
               "=SUMPRODUCT((R1C<=Mois_Reporting)*(Tb_B_COMPTE=RC1)*(Tb_B_ANNEE=YEAR(R7C))*(Tb_B_MOIS=R2C)*(Tb_B_BUDGETREEL=RC4)*(Tb_B_POSTE=RC2)*(Tb_B_BQ=""OUI"")*(Tb_B_DEBITCREDIT))"
          .Range(Cells(LigneCalcul, col), Cells(LigneCalcul, col + 11)).Value = .Range(Cells(LigneCalcul, col), Cells(LigneCalcul, col + 11)).Value
 
       Else
       End If
 
 
 
      Next col
Compteur = Compteur + 1
 
Next LigneCalcul
 
 
End With
 
MsgBox "Opération terminée pour " & Compteur & " itérations"
 
End Sub

QQn aurait un idée ?????

**eriiic** · 16/08/2017, 13h03

Bonjour,

tu peux concilier les 2 : écrire dans les cellules qui t'intéressent en une fois.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Sub test()
    Dim pl1 As Range, pl2 As Range, col As Long
    On Error GoTo fin
    Set pl1 = [A15:A650].SpecialCells(xlCellTypeConstants).EntireRow ' lignes
    On Error GoTo 0
    Set pl2 = Columns(6)
    For col = 6 To 36 Step 14
        Set pl2 = Union(pl2, Columns(col).Resize(, 12)) ' colonnes
    Next col
    Set pl1 = Intersect(pl1, pl2)
    pl1.FormulaR1C1 = "=SUMPRODUCT((R1C<=Mois_Reporting)*(Tb_B_COMPTE=RC1)*(Tb_B_ANNEE=YEAR(R7C))*(Tb_B_MOIS=R2C)*(Tb_B_BUDGETREEL=RC4)*(Tb_B_POSTE=RC2)*(Tb_B_BQ=""OUI"")*(Tb_B_DEBITCREDIT))"
    pl1.Value = pl1.Value
fin:
End Sub

Là j'ai supposé des constantes quelconques en A, mais tu peux adapter pour seulement des numériques, ou bien pour des résultats de formules d'un type précis ou non.
Tu peux compacter un peu plus le code, là j'ai voulu laissé la construction de la plage lisible facilement. Changer colonne de fin aussi
eric

**GADENSEB** · 16/08/2017, 13h13

Hello
Merci pr le code
Trés rapide, pr contre, il faut l'appliquer uniquement si la colonne A est remplie (non vide)
J'arrive pas à voir ou je dois placer le IF ???

avant

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Set pl1 = [A15:A650].SpecialCells(xlCellTypeConstants).EntireRow ' lignes

**eriiic** · 16/08/2017, 13h35

Bonjour,

tu n'as pas de if à mettre.
.SpecialCells(xlCellTypeConstants) sélectionne les cellules ayant une saisie et laisse les vides.
Comme je t'ai dit, si ce sont des formules en A il faudra faire autrement puisqu'une formule reste une formule même si elle retourne "".
Là tu mets A15:A650 dans un tableau que tu testes ligne à ligne, et tu agrandis la plage si <>""

PS : pas sûr que ça améliore le temps vu que c'est une écriture en une fois mais comme ce sont des matricielles et que ça ne coûte pas cher tu pourrais ajouter avant l'écriture :
Application.Calculation = xlCalculationManual
et rétablir juste après avec = xlCalculationAutomatic

**GADENSEB** · 16/08/2017, 13h39

okiiii
je vais tester cela ! ;-)

**GADENSEB** · 16/08/2017, 13h54

Re !!
le pl1.Value = pl1.Value déconne il me renvoi 0
si je n'en tiens pas compte les formules sont bien emplantées, et les résultats good
mais avec pl1.Value = pl1.Value , j'ai 0 à la place

par contre je ne piges pas :
Les Lignes sont vides en discontinues dans la colone A : parfois 2, c'est régulier et parfois 8 ou 10 suivant la présentation de mon tableau....
et du coup; tt est compacté:
Jusqu’à 30 j'ai 2 lignes vides, par étapes, puis 8 lignes vides........ et les formules semble garder le pas de 2 pour s'incrémenter....... c'est normal ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
 
Sub synthesedonnées2()
Application.Calculation = xlCalculationManual
    Dim pl1 As Range, pl2 As Range, col As Long
    On Error GoTo fin
    Set pl1 = [A15:A30].SpecialCells(xlCellTypeConstants).EntireRow ' lignes
    On Error GoTo 0
    Set pl2 = Columns(6).Resize(, 12)
    For col = 6 To 20 Step 14
        Set pl2 = Union(pl2, Columns(col).Resize(, 12)) ' colonnes
    Next col
    Set pl1 = Intersect(pl1, pl2)
    pl1.FormulaR1C1 = "=SUMPRODUCT((R1C<=Mois_Reporting)*(Tb_B_COMPTE=RC1)*(Tb_B_ANNEE=YEAR(R7C))*(Tb_B_MOIS=R2C)*(Tb_B_BUDGETREEL=RC4)*(Tb_B_POSTE=RC2)*(Tb_B_BQ=""OUI"")*(Tb_B_DEBITCREDIT))"
    pl1.Value = pl1.Value
fin:
 
Application.Calculation = xlCalculationAutomatic
End Sub

**eriiic** · 16/08/2017, 14h01

Ok, mais on ne sait toujours pas ce que tu as en A... Formules ou saisies ?
Fait en pas à pas et pl1.address en espion doit te donner les lignes retenues.
Et au final je n'ai les valeurs que ces lignes et sur les colonnes choisies.
Et je dois m'absenter qq heures...

**GADENSEB** · 16/08/2017, 14h07

Pardon je n'avais pas compris ta question.
En colonne A il ya simplement du texte (de la saisie)

voila l'espion

Nom : espion.PNG
Affichages : 102
Taille : 3,7 Ko

Nom : espion.PNG
Affichages : 102
Taille : 3,7 Ko

a tout

For Each et créer un pas de copier de formule [XL-2013]

Macros et VBA Excel

Discussions similaires

Partager

Partager