Nom d'une plage défini par VBA intégré dans une formule

[Daniel38]

Bonjour
Voilà je souhaiterai copier avec VBA une formule intégrant une plage nommée variable selon le nombre :
définition des plages
If NBEntreprise = 2 Then Range(Cells(LgRef, 10), Cells(LgRef, 15)).Select
If NBEntreprise = 3 Then Range(Cells(LgRef, 10), Cells(LgRef, 20)).Select
If NBEntreprise = 4 Then Range(Cells(LgRef, 10), Cells(LgRef, 25)).Select
If NBEntreprise = 5 Then Range(Cells(LgRef, 10), Cells(LgRef, 30)).Select

'nomme la plage des prix totaux (cela fonctionne très bien)
ActiveWorkbook.Names.Add Name:=Plage_Ref_Montant_HT, RefersToR1C1:=Selection

If NBEntreprise = 2 Then Range(Cells(LgRef, 7), Cells(LgRef, 12)).Select
If NBEntreprise = 3 Then Range(Cells(LgRef, 7), Cells(LgRef, 17)).Select
If NBEntreprise = 4 Then Range(Cells(LgRef, 7), Cells(LgRef, 22)).Select
If NBEntreprise = 5 Then Range(Cells(LgRef, 7), Cells(LgRef, 27)).Select

'nomme la plage des noms des entreprises (cela fonctionne très bien)
ActiveWorkbook.Names.Add Name:=Plage_Ref_Nom_Entreprise, RefersToR1C1:=Selection

' dans les dernières colonnes
For A = 1 To NBEntreprise
ActiveCell.Offset(0, 5).Select 'atteint la colonne pour insérer la formule d'extraction
Next A
'formules pour l'extraction des noms d'entreprises PU Tot Mini, PU Tot Moyen, PU Tot Median et PU Tot Maxi
ActiveCell.FormulaR1C1 = "=INDEX(!Plage_Ref_Nom_Entreprise,MATCH(R[-9]C,!Plage_Ref_Montant_HT))"
ActiveCell.Offset(0, 1).FormulaR1C1 = "=INDEX(!Plage_Ref_Nom_Entreprise,MATCH(R[-9]C,!Plage_Ref_Montant_HT))"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=INDEX(!Plage_Ref_Nom_Entreprise,MATCH(R[-9]C,!Plage_Ref_Montant_HT))"
ActiveCell.Offset(0, 3).FormulaR1C1 = "=INDEX(!Plage_Ref_Nom_Entreprise,MATCH(R[-9]C,!Plage_Ref_Montant_HT))"
(Là est le problème)
Je ne connais pas la syntaxe pour intégrer dans la formule la variable qui sert de référence pour les plages.
En fait je ne peux pas inclure le nom directement vu qu'il y a plusieurs feuilles pour les lots (noms différents) et plusieurs entreprises par lot (variables de 2 à 30) exemple ici avec 5 ...

Excel 2007 et Excel 2016

je continue de chercher ...

A bientôt
Daniel38

 

[Dranreb]

Mais Staple, elles ne s'inscrivaient pas, ces formules incorrectes, et un On Errror Resume Next bien avant empêchait le plantage.

 

[Daniel38]

En fait il n'écrivait rien le on error resume next était inutile, VBA continuait la suite ...

 

[Daniel38]

- très rapide même avec 30 lots et 20 offres par lots
Cette appli fait en 4 minutes l'équivalent d'1 semaine de travail pénible à la main et encore je suis très large dans le délais ...

Sub Formules()

Application.ScreenUpdating = False
Sheets("Menu").Select
Range("A2").Select
If Range("A3") <> "" Then
Range(Selection, Selection.End(xlDown)).Select
NbFeuils = Selection.Rows.Count
End If
If Range("A2") = "" Then NbFeuils = 1
NBEntreprise = 0
Range("A2").Select
For T = 1 To NbFeuils
Nomfeuil = ActiveCell
NBEntreprise = NBEntreprise + 1
Plage_Ref_Montant_HT = "Ref_Plage_PT_HT_" & ActiveCell.Offset(0, 4)
Plage_Ref_Nom_Entreprise = "Plage_Ref_Nom_Entreprise_" & ActiveCell.Offset(0, 4)
Sheets(Nomfeuil).Select

NBEntreprise = Range("A1")
If NBEntreprise > 1 Then
Range("A1").Select
ActiveCell.SpecialCells(xlLastCell).Select
lg = ActiveCell.Row
Range("A1").Select
For M = 1 To lg
If ActiveCell Like "Montant HT du Lot*" Then
LgRef = ActiveCell.Row
ColRef = ActiveCell.Column
Exit For
End If
ActiveCell.Offset(1, 0).Select
Next M
'repérage des plages de cellules pour nommer les plages des montants totaux par lot
Selection.End(xlToRight).Select
Selection.End(xlToRight).Select
If NBEntreprise = 2 Then Range(Cells(LgRef, 10), Cells(LgRef, 15)).Select
If NBEntreprise = 3 Then Range(Cells(LgRef, 10), Cells(LgRef, 20)).Select
If NBEntreprise = 4 Then Range(Cells(LgRef, 10), Cells(LgRef, 25)).Select
If NBEntreprise = 5 Then Range(Cells(LgRef, 10), Cells(LgRef, 30)).Select
If NBEntreprise = 6 Then Range(Cells(LgRef, 10), Cells(LgRef, 35)).Select
If NBEntreprise = 7 Then Range(Cells(LgRef, 10), Cells(LgRef, 40)).Select
If NBEntreprise = 8 Then Range(Cells(LgRef, 10), Cells(LgRef, 45)).Select
If NBEntreprise = 9 Then Range(Cells(LgRef, 10), Cells(LgRef, 50)).Select
If NBEntreprise = 10 Then Range(Cells(LgRef, 10), Cells(LgRef, 55)).Select
'nomme la plage des prix totaux
ActiveWorkbook.Names.Add Name:=Plage_Ref_Montant_HT, RefersToR1C1:=Selection
On Error Resume Next
ActiveWorkbook.Names("Ref_Plage_PT_HT_").Delete
Range("A1").Select
For M = 1 To lg
If ActiveCell Like "Montant HT du Lot*" Then
Exit For
End If
ActiveCell.Offset(1, 0).Select
Next
ActiveCell.Offset(9, 5).Select
LgRef = ActiveCell.Row
'repérage des plages de cellules pour nommer les plages des montants totaux par lot
If NBEntreprise = 2 Then Range(Cells(LgRef, 7), Cells(LgRef, 12)).Select
If NBEntreprise = 3 Then Range(Cells(LgRef, 7), Cells(LgRef, 17)).Select
If NBEntreprise = 4 Then Range(Cells(LgRef, 7), Cells(LgRef, 22)).Select
If NBEntreprise = 5 Then Range(Cells(LgRef, 7), Cells(LgRef, 27)).Select
If NBEntreprise = 6 Then Range(Cells(LgRef, 7), Cells(LgRef, 32)).Select
If NBEntreprise = 7 Then Range(Cells(LgRef, 7), Cells(LgRef, 37)).Select
If NBEntreprise = 8 Then Range(Cells(LgRef, 7), Cells(LgRef, 42)).Select
If NBEntreprise = 9 Then Range(Cells(LgRef, 7), Cells(LgRef, 47)).Select
If NBEntreprise = 10 Then Range(Cells(LgRef, 7), Cells(LgRef, 52)).Select

'nomme la plage des noms des entreprises
ActiveWorkbook.Names.Add Name:=Plage_Ref_Nom_Entreprise, RefersToR1C1:=Selection

For A = 1 To NBEntreprise
ActiveCell.Offset(0, 5).Select 'atteint les dernères cellules pour la formule d'extraction
Next A

'#### le problème était ici
'formules pour l'extraction des noms d'entreprises PU Tot Mini, PU Tot Moyen, PU Tot Median et PU Tot Maxi
ActiveCell.FormulaR1C1 = "=INDEX(" & Plage_Ref_Nom_Entreprise & ",MATCH(R[-9]C," & Plage_Ref_Montant_HT & "))"
ActiveCell.Offset(0, 1).FormulaR1C1 = "=INDEX(" & Plage_Ref_Nom_Entreprise & ",MATCH(R[-9]C," & Plage_Ref_Montant_HT & "))"
ActiveCell.Offset(0, 2).FormulaR1C1 = "=INDEX(" & Plage_Ref_Nom_Entreprise & ",MATCH(R[-9]C," & Plage_Ref_Montant_HT & "))"
ActiveCell.Offset(0, 3).FormulaR1C1 = "=INDEX(" & Plage_Ref_Nom_Entreprise & ",MATCH(R[-9]C," & Plage_Ref_Montant_HT & "))"



End If
Sheets("Menu").Select
ActiveCell.Offset(1, 0).Select
Next T
Nomfeuil = Nothing
End Sub

 

[Staple1600]

Re

Effectivement, j'avais zappé le On Error
Donc en guise de pénitence, j'ai réécrit le début de ton code sans Select (juste à titre illustratif)

Sub Formules()
Dim p As Range
Application.ScreenUpdating = False
Set p = Sheets("Menu").Range("A3")
If Len(p) Then NbFeuils = Sheets("Menu").Range("A3").CurrentRegion.Rows.Count
If IsEmpty(p.Offset(-1)) Then NbFeuils = 1
NBEntreprise = 0
For T = 1 To NbFeuils
'....

 

[Daniel38]

Oh OK
je vois le truc tu penses que c'est + rapide ?
je vois que ça traite les lignes vides aussi
bien cool

Jub Jub Mac Mac 😉 😉

 

[Staple1600]

Re

Je ne pense rien
Encore une fois, partout sur les forums dédiés avec Excel, on conseille d'éviter les Select, Activate
Ce lien n'existe plus
Ou ici aussi

excel — Comment éviter d'utiliser Select in Excel VBA

J'ai beaucoup entendu parler de l'horreur compréhensible d'utiliser .Select dans Excel VBA, mais je ne sais pas comment éviter de l'utiliser. Je trouve que mon code serait plus réutilisable si je pouvais utiliser des variables au lieu de fonctions...

www.it-swarm.net

Bref le net regorge d'exemples qui expliquent le pourquoi de la chose.

Mais tu es tout a fait libre d'aller à contre-courant 😉

 

[Daniel38]

Oops
après un test
ça ne prend pas en compte si il n'y a qu'un lot !
je faisais pour ça :

Range("A2").Select
If Range("A3") <> "" Then
Range(Selection, Selection.End(xlDown)).Select
NbFeuils = Selection.Rows.Count
End If
If Range("A2") = "" Then NbFeuils = 1

J'ai remplacé
If IsEmpty(p.Offset(-1)) Then NbFeuils = 1
par
If IsEmpty(p.Offset(1)) Then NbFeuils = 1 (puisqu'on descend)

mais non !!!

 

[Staple1600]

Re

J'ai ajouté des choses dans l'édition de mon précédent message
Et pour le code, comme indiqué ce n'était qu'illustratif niveau syntaxe.

 

[Staple1600]

Re

Cela te convient mieux ainsi

Sub Formules()
Dim p As Range
Application.ScreenUpdating = False
Set p = Sheets("Menu").Range("A3")
If IsEmpty(p.Offset(-1)) Then NBFeuils = 1
If Len(p) Then NBFeuils = Sheets("Menu").Range("A3").CurrentRegion.Rows.Count
MsgBox NBFeuils ' juste pour tester et uniquement pour cela
End Sub

 

[Daniel38]

Merci de me guider Staple, j'aime oui je lis ton complément
Pas facile mais je comprends le truc 😉

 

[Daniel38]

en fait CurrentRegion s'arrete à la 1ere ligne vide et donc avec 1 seul lot ça plante pas de numéro dans la
MsgBox

 

[Staple1600]

Re

Un peu plus simple

Sub Formules()
Application.ScreenUpdating = False
x = Sheets("Menu").Cells(Rows.Count, 1).End(3).Row - 1
If x < 1 Then NBFeuils = 1 Else NBFeuils = x
MsgBox NBFeuils

Là ca fonctionne comme tu veux?

Si oui, c'est donc sans Select ni Activate 😉

 

[Daniel38]

Non plus lol
En fait je préfère écrire de façon simple
time for dodo
merci
bonne fin de soirée 😉

 

[Staple1600]

Re

Bah si je testes sur ton classeur tel quel
La Msgbox affiche 3 (qui est bien la bonne valeur de NbFeuil, non ?)
Et si je vide la colonne A (alors A2 est vide) donc NBFeuil=1

 

[Daniel38]

Oui mais supprime la 2ème ligne tu verras en gros comme dit ci-avant si tu as qu'un seul lot
ici pas de chiffre dans la msgbox ?
Bon je déconnecte
Bye