Code VBA avec une boucle pour réduire la longueur d'une macro

BChaly · 16 Décembre 2011

Bonsoir à tous,

Je cherche un code avec une boucle pour réduire une macro (voir fichier joint) qui fonctionne. Il s'agit de remplir les cellules de tableaux, à conditions que les cellules figurant dans des tableaux identiques, mais dans un autre fichier "Base" soient < > 0.

Y-a-t-il une possibilité?

Merci pour votre aide.

Cordialement

BChaly

Code
************************************************

Sub Test()

With Sheets("JAN").Range("C3:G20")
.Formula = "=IF(ISBLANK('F:\[Base.xls]JAN'!RC),"""",""ABC"")"
.Value = .Value
End With

With Sheets("JAN").Range("C23:G30")
.Formula = "=IF(ISBLANK('F:\[Base.xls]JAN'!RC),"""",""ABC"")"
.Value = .Value
End With

With Sheets("FEV").Range("C3:G20")
.Formula = "=IF(ISBLANK('F:\[Base.xls]FEV'!RC),"""",""ABC"")"
.Value = .Value
End With

With Sheets("FEV").Range("C23:G30")
.Formula = "=IF(ISBLANK('F:\[Base.xls]FEV'!RC),"""",""ABC"")"
.Value = .Value
End With

' ...........................................etc
' pour tous les mois de l'année.

End Sub

************************************************

Papou-net · 16 Décembre 2011

Re : Code VBA avec une boucle pour réduire la longueur d'une macro

Bonsoir BChaly,

A priori (non testé) tu dois pouvoir simplifier ta macro comme suit :

Code:

Sub Test()
Dim Sh As Object

For Each Sh In Sheets
    With Sh.Range("C3:G20")
        .Formula = "=IF(ISBLANK('F:\[Base.xls]SEP'!RC),"""",""ABC"")"
        .Value = .Value
    End With
    With Sh.Range("C23:G30")
        .Formula = "=IF(ISBLANK('F:\[Base.xls]SEP'!RC),"""",""ABC"")"
        .Value = .Value
    End With
Next
End Sub

Attention, si ton classeur possède d'autres feuilles, il faut revoir la boucle "For Each Sh..."

Espérant avoir répondu.

Cordialement.

Staple1600 · 16 Décembre 2011

Re : Code VBA avec une boucle pour réduire la longueur d'une macro

Bonsoir à tous

Papou-net:
Le nom des onglets de la feuille source change aussi:

With Sheets("NOV").Range("C23:G30")
.Formula = "=IF(ISBLANK('F:\[Base.xls]NOV'!RC),"""",""ABC"")"
.Value = .Value
End With

With Sheets("DEC").Range("C3:G20")
.Formula = "=IF(ISBLANK('F:\[Base.xls]DEC'!RC),"""",""ABC"")"
.Value = .Value
End With

Non testé non plus (et pour cause j'ai point de F: )

Code:

Sub TestII()
Dim Sh As worksheet
For Each Sh In Worksheets
    With Sh.Range("C3:G20,C23:G30")
        .Formula = "=IF(ISBLANK('F:\[Base.xls]" & Sh.Name & "'!RC),"""",""ABC"")"
        .Value = .Value
    End With
Next
End Sub

Staple1600 · 16 Décembre 2011

Re : Code VBA avec une boucle pour réduire la longueur d'une macro

Re

Juste pour le fun , et pour m’attirer les foudres des adeptes de l'écriture classique

Code:

Sub TestIII()
Dim Sh As worksheet, a$, b$
a = "C3:G20,C23:G30"
b = "=IF(ISBLANK('F:\[Base.xls]" & Sh.Name & "'!RC),"""",""ABC"")"
For Each Sh In Worksheets
With Sh.Range(a): .Formula = b: .Value = .Value: End With
Next
End Sub

Papou-net · 16 Décembre 2011

Re : Code VBA avec une boucle pour réduire la longueur d'une macro

Staple1600 à dit:
Bonsoir à tous

Papou-net:
Le nom des onglets de la feuille source change aussi:

Bonsoir Staple1600,

Bien vu, j'avais pas vu.

Cordialement.

BChaly · 16 Décembre 2011

Re : Code VBA avec une boucle pour réduire la longueur d'une macro

Merci à Papou-net d'avoir étudié le problème.

Bravo Staple1600, Bien vu, et Merci beaucoup.

Dans la première solution il y a un petit problème avec "Range("C3:G20,C23:G30")":
En effet les 3 dernières lignes ne sont pas prises en compte.
Est-ce du à la séparation des deux tableaux? Je me penche sur le problème.

Quant à la deuxème solution, elle bloque sur "b = ..."

Cordialement

Staple1600 · 16 Décembre 2011

Re : Code VBA avec une boucle pour réduire la longueur d'une macro

Re

La première fonctionne au moins ?
(L'autre on peut l'oublier, c'est juste pour divertir mes vieux jours, les soirs de tempête)

Essaie TestII en la scindant en deux boucles comme le fit Papou-net.

BChaly · 16 Décembre 2011

Re : Code VBA avec une boucle pour réduire la longueur d'une macro

Oui, c'est bien ça, il fallait scinder les deux boucles.

Merci encore une fois à tous les deux.

Voici la solution pour ceux qui seraient intéressés:

Bonne soirée

Cordialement,

**************************************

Sub TestII()
Dim Sh As Worksheet
For Each Sh In Worksheets
With Sh.Range("C3:G20")
.Formula = "=IF(ISBLANK('F:\[Base.xls]" & Sh.Name & "'!RC),"""",""ABC"")"
.Value = .Value
End With
With Sh.Range("C23:G30")
.Formula = "=IF(ISBLANK('F:\[Base.xls]" & Sh.Name & "'!RC),"""",""ABC"")"
.Value = .Value
End With
Next
End Sub

***************************************

Staple1600 · 16 Décembre 2011

Re : Code VBA avec une boucle pour réduire la longueur d'une macro

Re

Par curiosité camarcheticomessaussi?

Code:

Sub TestII4FunBis()
Dim Sh As Worksheet
For Each Sh In Worksheets
With Sh.Range("C3:G20")
.Formula = "=IF(ISBLANK('F:\[Base.xls]" & Sh.Name & "'!RC),"""",""ABC"")"
.Value = .Value
With .Offset(20).Resize(8)
.Formula = "=IF(ISBLANK('F:\[Base.xls]" & Sh.Name & "'!RC),"""",""ABC"")"
.Value = .Value
End With
End With
Next
End Sub

BChaly · 19 Décembre 2011

Re : Code VBA avec une boucle pour réduire la longueur d'une macro

Oui ça fonctionne également.

Merci encore une fois pour l'intérêt porté à ma question.

Cordialement,

Staple1600 · 19 Décembre 2011

Re : Code VBA avec une boucle pour réduire la longueur d'une macro

Bonsoir

Y a pas de raison que cela ne fonctionne pas pourtant...
Essaies tu verras que la MsgBox affiche bien la bonne adresse

Code:

Sub TestII4FunTer()
Dim Sh As Worksheet
For Each Sh In Worksheets
With Sh.Range("C3:G20")
.Formula = "=IF(ISBLANK('F:\[Base.xls]" & Sh.Name & "'!RC),"""",""ABC"")"
.Value = .Value
With .Offset(20).Resize(8)
MsgBox .Address ' par acquis de conscience
.Formula = "=IF(ISBLANK('F:\[Base.xls]" & Sh.Name & "'!RC),"""",""ABC"")"
.Value = .Value
End With
End With
Next
End Sub

BChaly · 19 Décembre 2011

Re : Code VBA avec une boucle pour réduire la longueur d'une macro

Pardon, je m'étais précipité dans ma réponse.

Oui, ça fonctionne très bien.

Bonne soirée.

Cordialement,

Code VBA avec une boucle pour réduire la longueur d'une macro

BChaly

XLDnaute Occasionnel

Pièces jointes

Papou-net

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Staple1600

XLDnaute Barbatruc

Papou-net

XLDnaute Barbatruc

BChaly

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

BChaly

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

BChaly

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

BChaly

XLDnaute Occasionnel

Discussions similaires