Boostez vos compétences Excel avec notre communauté !
Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force.
Apprenez, échangez, progressez – et tout ça gratuitement !
👉 Inscrivez-vous maintenant !
J'ai un problème lors de la création de noms de plage sous VBA. J'utilise une variable comme référence de plage pour ce nom. Cette variable a été préalablement créee, lors d'une boucle.
Le code bloque avec une erreur 1004 lorsque ma référence de plage est trop longue (environ 3000 caractères). Connaissez vous une solution pour éviter ce bloquage ?
Merci.
li = 2
Do While Not [base].Cells(li, 3) = ""
test = 0
For aa = 1 To nb_crit
If crit(aa) = "" Then
Else
If [base].Cells(li, col_crit(aa)).Value = crit(aa) Then
'test = test
Else
test = test + 1
Exit For
End If
End If
Next
If test = 0 Then
nom = nom & "Db!R" & li & "C" & col_chp & ","
test = False
End If
li = li + 1
Loop
If IsEmpty(nom) = False Then
nom = "=" & Left(nom, Len(nom) - 1)
Debug.Print Len(nom)
ActiveWorkbook.Names.Add Name:=nom_nom, RefersToR1C1:=CStr(nom)
End If
petites remarques :
Nommer une plage sert à raccourcir les références, 3000 caractères me semble un peu longuet...
On donne toujours une macro en intégralité.
Pas sûr de la définition de la variable test, dans ton code :
- test=test+1 => impliquerait une définition en nombre
- test=false => impliquerait une variable en booléen
Comme tu l'utilises dans ton code, j'opterais pour une variable booléenne
- test=test+1 devenant test=true
- if test=0 then devenant if test=false then
Une variable booléenne à False est égale à 0. Donc si tu testes qu'elle est à 0, pas besoin de la mettre à false
Dans ton code :
Code:
if condition then
Else
code de traitement
End if
Tu n'utilises que la partie ne répondant pas au critère. Transformes ton critère en son inverse et supprimes les Else
....
If crit(aa) <> "" Then
..........
If not([base].Cells(li, col_crit(aa)).Value = crit(aa)) Then
Pour ton problème :
N'ayant pas tout les éléments, juste une idée :
- le nom, pourrait être : "crit_" & aa
- utiliser une variable range pour "sommer" les différentes cellules concernées, et en sortie du genre
Code:
Sub test()
Dim Plage As Range, FlgTest As Boolean, Li As Long
'..............
Li = 2
Do While Not [base].Cells(Li, 3) = ""
FlgTest = False
For aa = 1 To nb_crit
If crit(aa) <> "" Then
If Not ([base].Cells(Li, col_crit(aa)).Value = crit(aa)) Then
FlgTest = True
Exit For
End If
End If
Next aa
If test = False Then
If Plage Is Nothing Then
Set Plage = Sheets("Db").Cells(Li, col_chp)
Else
Set Plage = Union(Plage, Sheets("Db").Cells(Li, col_chp))
End If
End If
Li = Li + 1
Loop
If Not (Plage Is Nothing) Then
nom = "=Crit_" & aa 'voir comment le définir
'Debug.Print Len(nom)
ActiveWorkbook.Names.Add Name:=nom, RefersTo:=Plage
End If
End Sub
Mais je ne l'ai pas testé, n'ayant pas le code entier
A+
Je viens d'essayer de passer par une variable range plutôt qu'une variable string : ca parait bien plus logique ! Mais je n'arrive pas à incrémenter cette variable : ca me donne toujours plage = valeur de la cellule en question ...
L'objectif de ce code est de calculer une médiane conditionnelle, en se débrouillant pour pouvoir utiliser les mêmes formats de critères que les fonctions de base de données BDMOYENNE, BDMIN, etc ...
Le test en boolean n'est pas utilisable, puisque je veux que les lignes respectent tout les critères. Le test=false qui restait dans le code était un oubli de ma part ... 😕
Merci de votre aide !
Code:
Private Sub Worksheet_Calculate()
debug.print time
Set mafeuille = ActiveWorkbook.Sheets("Outil")
For a = 1 To 10
Call med("critère" & a, "liste_med" & a)
Next
Debug.Print Time
End Sub
Sub med(critere As String, nom_nom As String)
nb_crit = 5
col_chp = 16
Dim col_crit()
ReDim col_crit(1 To nb_crit)
Dim crit()
ReDim crit(1 To nb_crit)
Dim plage As Range
'On parcourt la base pour trouver les numéros de colonnes correspondant à chaque critère.
'On les passe en variable dans le tableau col_crit, et le critère passe en variable dans le tableau crit
For a = 1 To [base].Columns.Count
For b = 1 To nb_crit
If [base].Cells(1, a) = ActiveWorkbook.Names(critere).RefersToRange.Cells(1, b) Then
col_crit(b) = a
crit(b) = ActiveWorkbook.Names.Item(critere).RefersToRange.Cells(2, b)
Exit For
End If
Next
Next
'on parcourt la base pour identifier les lignes respectant TOUT les critères
li = 2
Do While Not [base].Cells(li, 3) = ""
test = 0
For aa = 1 To nb_crit
If crit(aa) <> "" Then
If [base].Cells(li, col_crit(aa)).Value <> crit(aa) Then
test = test + 1
Exit For
End If
End If
Next
'On incrémente la plage de cellule
If test = 0 Then
If plage Is Nothing Then
Set plage = Sheets("Db").Range("P" & li)
Else
Set plage = Union(plage, Sheets("Db").Range("P" & li))
End If
End If
li = li + 1
Loop
If plage Is Nothing Then
For Each liste In ActiveWorkbook.Names
If liste.Name = nom_nom Then
ActiveWorkbook.Names(nom_nom).Delete
Exit For
End If
Next
Exit Sub
End If
'On nomme la plage de cellule
If Not (plage Is Nothing) Then
ActiveWorkbook.Names.Add Name:=nom_nom, RefersToR1C1:=plage
End If
End Sub
Ca a l'air de fonctionner, même si je ne suis pas sûre de savoir quel(s) changements ont fonctionnés ... Voilà le code :
Code:
Sub med(critere As String, nom_nom As String)
nb_crit = 5
col_chp = 16
Dim col_crit()
ReDim col_crit(1 To nb_crit)
Dim crit()
ReDim crit(1 To nb_crit)
Dim maplage As Range
'On parcourt la base pour trouver les numéros de colonnes correspondant à chaque critère.
'On les passe en variable dans le tableau col_crit, et le critère passe en variable dans le tableau crit
For a = 1 To [base].Columns.Count
For b = 1 To nb_crit
If [base].Cells(1, a) = ActiveWorkbook.Names(critere).RefersToRange.Cells(1, b) Then
col_crit(b) = a
crit(b) = ActiveWorkbook.Names.Item(critere).RefersToRange.Cells(2, b)
Exit For
End If
Next
Next
Worksheets("Db").Select
'on parcourt la base pour identifier les lignes respectant TOUT les critères
li = 2
Do While Not [base].Cells(li, 3) = ""
test = 0
For aa = 1 To nb_crit
If crit(aa) <> "" Then
If [base].Cells(li, col_crit(aa)).Value <> crit(aa) Then
test = test + 1
Exit For
End If
End If
Next
'On incrémente la plage de cellule
If test = 0 Then
If maplage Is Nothing Then
Set maplage = Range("P" & li)
Else
Set maplage = Union(maplage, Range("P" & li))
End If
End If
li = li + 1
Loop
If maplage Is Nothing Then
For Each liste In ActiveWorkbook.Names
If liste.Name = nom_nom Then
ActiveWorkbook.Names(nom_nom).Delete
Exit For
End If
Next
Exit Sub
End If
'On nomme la plage de cellule
If Not (maplage Is Nothing) Then
ActiveWorkbook.Names.Add Name:=nom_nom, RefersTo:=maplage
End If
End Sub
- Navigue sans publicité - Accède à Cléa, notre assistante IA experte Excel... et pas que... - Profite de fonctionnalités exclusives Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel. Je deviens Supporter XLD