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,