Doute sur variable

Version imprimable

Doute sur variable

bonsoir au forum
je parcours 2 feuilles (S1 & S2) avec condition "Tb(x,18)>0", si oui, inscrit sur une 3 ème feuille (S7), une partie de la ligne source

l'utilisation de "Sel" (lignes 9 & 10) m'est obligatoire au bon fonctionnement de ma sous-proc, mais je doute (comme d'hab) fortement de cette obligation

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
1         Set S7 = Sheets(7)
2     For Each S In Worksheets(Array(1, 2))
3         Nbl_12 = S.Range("B" & S.Rows.Count).End(xlUp).Row
4         Tb = S.Range("B1:S" & Nbl_12)
5             For x = 2 To UBound(Tb, 1)
6                 If Tb(x, 18) > 0 Then                                           'montant don
7                 i = S.Range("B" & x).FormatConditions(1).Interior.ColorIndex    'récup index couleur fond S
8                 Nbl7 = S7.Range("B" & S7.Rows.Count).End(xlUp).Row + 1
9                 Sel = S.Range("B" & x & ":S" & x)
10                S7.Range("A" & Nbl7 & ":R" & Nbl7) = Sel
11                S7.Range("A" & Nbl7 & ":R" & Nbl7).Interior.ColorIndex = i      'appli index couleur fond S7
12                End If
13            Next x
14    Next S

alors propositions d'amélioration me seraient agréables
merci de m'avoir lu

24/09/2013, 22h24
Invité
Tu peux tout simplement écrire:

Code:

S7.Range("A" & Nbl7 & ":R" & Nbl7) = S.Range("B" & x & ":S" & x)

à la place de:
Code:

1 2 Sel = S.Range("B" & x & ":S" & x) S7.Range("A" & Nbl7 & ":R" & Nbl7) = Sel
et ta variable disparait.

Salut

Voila quelques propositions de modification.

A mon sens la modification la plus importante est celle concernant la précision du classeur sur lequel le code est appliqué, en cas de changement de classeur actif, la macro continuerait à dérouler en modifiant les cellule du nouveau classeur.

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
Dim Thecell As Range
    'Pour éviter les ennuis, il vaut mieux toujours préciser sur quel classeur tu travailles.
    Set S7 = ThisWorkbook.Sheets(7)
    For Each S In ThisWorkbook.Worksheets(Array(1, 2))
        'Nbl_12 = S.Range("B" & S.Rows.Count).End(xlUp).Row
        'Tb = S.Range("B1:S" & Nbl_12)
        'For x = 2 To UBound(Tb, 1)
        For Each Thecell In S.Range("B1", S.Cells(S.Rows.Count, "B").End(xlUp).Offset(, 17))
            'If Tb(x, 18) > 0 Then                                           'montant don
            If Thecell.Offset(, 17) > 0 Then 'il faudra peut-être corriger la valeur de l'offset)
                i = Thecell.FormatConditions(1).Interior.ColorIndex    'récup index couleur fond S
                'Nbl7 = S7.Range("B" & S7.Rows.Count).End(xlUp).Row + 1
                'Si Sel n'est utilisé qu'une seule fois par la suite, tu peux intégrer "sa formule" directement dans la suite du code
                'Sel = S.Range("B" & x & ":S" & x)
                'Pour éviter de déclarer plein de variables NB12, NB17,... il est possible d'utiliser la structure With
                With S7.Range("B" & S7.Rows.Count).End(xlUp).Offset(1, -1).Resize(1, 18)
                    'S7.Range("A" & Nbl7 & ":R" & Nbl7) = S.Range("B" & x & ":S" & x) 'Sel
                    'S7.Range("A" & Nbl7 & ":R" & Nbl7).Interior.ColorIndex = i      'appli index couleur fond S7
                    .Value = S.Range("B" & x & ":S" & x)
                    .Interior.ColorIndex = i
                End With
            End If
        Next x
    Next S

Comme précisé dans le code modifié, il faudra sans doute corriger l'offset appliquer à la plage Thecell (If Thecell.Offset(, 17) > 0 Then), car je me fait toujours avoir avec les plages qui commencent à 0 ou à 1 :p

++
Qwaz

25/09/2013, 11h41
leronce

merci à vous deux pour vos réponses

@vcottineau
ta proposition ne fonctionne pas, c'était pour cela que je passais par une intermédiaire

@Qwazerty
j'explore ta proposition, sans résultat pour l'instant (hi)
je vois qu'elle parcourt toutes les cellules de chaque colonne
je joue avec les offset, ensuite comprendre .. c'est pas encore gagné

je marque résolu, l'obstination fait partie de mes heu défauts/qualités

Salut

Quand tu dis que la proposition de vcottineau ne fonctionne pas, quelle est l'erreur?

Essai en ajoutant la propriété visé

Code:

S7.Range("A" & Nbl7 & ":R" & Nbl7).value = S.Range("B" & x & ":S" & x).value

Pour mon code, j'ai fais deux erreur désolé.

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
Dim Thecell As Range
    'Pour éviter les ennuis, il vaut mieux toujours préciser sur quel classeur tu travailles.
    Set S7 = ThisWorkbook.Sheets(7)
    For Each S In ThisWorkbook.Worksheets(Array(1, 2))
        'Nbl_12 = S.Range("B" & S.Rows.Count).End(xlUp).Row
        'Tb = S.Range("B1:S" & Nbl_12)
        'For x = 2 To UBound(Tb, 1)
    '1ere erreur tu ne veux boucler que sur la colonne S en utilisant la colonne B uniquement pour définir le nombre de ligne
    'Ca modifie le reste du code car TheCell représente maintenant les cellules de la colonne S (est non B)
        For Each Thecell In S.Range("S1", S.Cells(S.Rows.Count, "B").End(xlUp).Offset(, 17))
            'If Tb(x, 18) > 0 Then                                           'montant don
            If Thecell > 0 Then 'il faudra peut-être corriger la valeur de l'offset)
                i = Thecell.FormatConditions(1).Interior.ColorIndex    'récup index couleur fond S
                'Nbl7 = S7.Range("B" & S7.Rows.Count).End(xlUp).Row + 1
                'Si Sel n'est utilisé qu'une seule fois par la suite, tu peux intégrer "sa formule" directement dans la suite du code
                'Sel = S.Range("B" & x & ":S" & x)
                'Pour éviter de déclarer plein de variables NB12, NB17,... il est possible d'utiliser la structure With
                With S7.Range("B" & S7.Rows.Count).End(xlUp).Offset(1, -1).Resize(1, 18)
                    'S7.Range("A" & Nbl7 & ":R" & Nbl7) = S.Range("B" & x & ":S" & x) 'Sel
                    'S7.Range("A" & Nbl7 & ":R" & Nbl7).Interior.ColorIndex = i      'appli index couleur fond S7
                '2ème erreur
                    .Value = Thecell.Offset(, -17).Resize(1, 18)
                    .Interior.ColorIndex = i
                End With
            End If
        Next x
    Next S
 
End Sub

Si tu as une version plus complète du code pour pouvoir tester le résultat n'hésite pas à la poster, si tu veux plus d'info sur le code, des passage que tu ne comprend pas, n'hésite pas non plus, le forum est fait pour ça.

Bon courage
++
Qwaz

25/09/2013, 14h56
leronce

Code:

S7.Range("A" & Nbl7 & ":R" & Nbl7).value = S.Range("B" & x & ":S" & x).value

impeccable, ça fonctionne

quant à ta 1ère proposition, après coup, j'avais trouvé l'origine
pour la 2ème, hormis colorindex, je n'ai rien
à moi de comprendre l'alliance offset & resize

pour un code plus complet ... hi! plus de 300 lignes répartis en 18 proc, sur lesquelles je travaille pour les alléger & améliorer.
j'ai commencé avec 652 lignes, je suis donc sur la bonne voie

Salut

Citation:

pour la 2ème, hormis colorindex, je n'ai rien

Donc i peut-être suprimé

Code:

1
2
3
4
5
6
7
8
9
10
 
           If Thecell > 0 Then
                'Nbl7 = S7.Range("B" & S7.Rows.Count).End(xlUp).Row + 1
                With S7.Range("B" & S7.Rows.Count).End(xlUp).Offset(1, -1).Resize(1, 18)
                    'S7.Range("A" & Nbl7 & ":R" & Nbl7) = S.Range("B" & x & ":S" & x) 'Sel
                    'S7.Range("A" & Nbl7 & ":R" & Nbl7).Interior.ColorIndex = i      'appli index couleur fond S7
                '2ème erreur
                    .Value = Thecell.Offset(, -17).Resize(1, 18)
                    .Interior.ColorIndex = Thecell.FormatConditions(1).Interior.ColorIndex
                End With

Si TheCell correspond à la cellule F2, avec un offset(1,5) on pointe sur la cellule K3 et avec un resize(2,3) on pointe sur la plage K3:N4.

++
Qwaz

cette fois-ci, vraiment résolu

@ Qwazerty: merci pour les aide, conseils & leçons
j'ai noté dans la proc, le résultat d'un offset suivi de resize pour pense-bête (hi)

modifs
je démarre en S2 pour le départ de boucle, S1 = titre colonne
i est resté
j'ai rajouté value à ".Value = Thecell.Offset(, -17).Resize(1, 18).Value"

donc code final ci-dessous

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub don()
      Dim Thecell As Range, S7 As Worksheet, S As Worksheet, i As String
1      Set S7 = ThisWorkbook.Sheets(7)
2         For Each S In ThisWorkbook.Worksheets(Array(1, 2))
3             For Each Thecell In S.Range("S2", S.Cells(S.Rows.Count, "B").End(xlUp).Offset(, 17))
4                 If Thecell > 0 Then
5                     i = Thecell.FormatConditions(1).Interior.ColorIndex         'récup index couleur fond S
6                     With S7.Range("B" & S7.Rows.Count).End(xlUp).Offset(1, -1).Resize(1, 18)
7                         .Value = Thecell.Offset(, -17).Resize(1, 18).Value
8                         .Interior.ColorIndex = i
9                     End With
10                End If
11            Next Thecell
12        Next S
End Sub