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

[BChaly]

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]

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 :

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]

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: )

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]

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

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]

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:

Bonsoir Staple1600,

Bien vu, j'avais pas vu.

Cordialement.

 

[BChaly]

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]

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]

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]

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

Re

Par curiosité camarcheticomessaussi?

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]

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]

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

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]

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,