Names.Add : référence trop longue

[moggle]

Bonjour,

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

 

[Gorfael]

Re : Names.Add : référence trop longue

Salut moggle et le forum

(environ 3000 caractères). Connaissez vous une solution pour éviter ce bloquage ?

Raccourcir le nom 😛

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 :

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

Ton code en deviendra plus lisible

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

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+

 

[moggle]

Re : Names.Add : référence trop longue

Salut Gorfael et le forum,

Tu trouveras ci dessous la procédure complète.

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 !

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

 

[moggle]

Re : Names.Add : référence trop longue

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 :

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

Merci !