VBA Named Range : le moyen le plus efficace de vérifier si le nom existe

Question

J'ai une routine, qui consiste à remplir un calendrier avec tous les événements importants pour les marchés des matières premières pour chaque jour de la semaine suivante. J'ai une grille de calendrier disposée sur la page et j'ai dix cellules nommées pour chaque jour, c'est-à-dire lundi 1, lundi 2 et ainsi de suite (chaque jour ne va que jusqu'à 10 pour le moment, c'est-à-dire lundi 10), dans la colonne de chaque jour. En fait, les cellules ont une largeur de 2 cellules et une profondeur de 2 cellules. Souvent, il y a plus de 10 événements pour un jour donné. J'essaie de tester la plage nommée pour voir si elle existe, sinon je copie le format de la dernière cellule de la plage nommée et je nomme cette cellule le nom suivant dans la série.

J'ai seulement deux problèmes avec ce qui précède, le premier et le plus important est de savoir comment tester pour déterminer si un nom pour une plage nommée existe déjà. Je suis en train d'itérer à travers la liste entière de ThisWorkbook.Names, qui contient des milliers de plages nommées. Comme cette itération peut être exécutée plus de 100 fois lorsque le calendrier est généré, elle est très lente (comme on peut s'y attendre). Existe-t-il un meilleur moyen, plus rapide, de vérifier si un nom existe déjà en tant que plage nommée ?

Le deuxième problème est de savoir comment copier le formatage d'une cellule fusionnée de 4 cellules, puisque l'adresse n'apparaît toujours que dans la cellule du coin supérieur gauche et que le décalage de la plage ne fonctionne pas correctement. J'ai bidouillé pour obtenir ce code afin d'obtenir au moins la bonne plage pour le prochain groupe de cellules fusionnées de la colonne.

Set cCell = Range("Thursday" & CStr(y))
'even tho cCell is a 4 cell merged cell, cCell.Address returns the address of top left cell
Set destRange = Range(cCell.Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)

L'enregistrement d'une macro pour faire glisser le formatage vers le bas, montre ce code.

Range("G22:H23").Select
Selection.AutoFill Destination:=Range("G22:H25"), Type:=xlFillFormats
Range("G22:H25").Select

Puisque Range("G22:H23") est identique à cCell, et Range("G22:H25") est identique à destRange. Le code suivant devrait fonctionner, mais ne fonctionne pas.

Set cCell = Range("Thursday" & CStr(y))
Set destRange = Range(cCell.Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)
cCell.AutoFill Destination:=destRange, Type:=xlFillFormats
Application.CutCopyMode = False
cCell.offset(1, 0).Name = rangeName

Pour information, cela ne fonctionne pas non plus si je sélectionne cCell et utilise Selection.AutoFill.

Avez-vous une idée de la façon dont vous pouvez copier le formatage de cette cellule dans la colonne, une cellule à la fois, si nécessaire ?

Mise à jour :

Cela fonctionne maintenant pour copier le formatage d'une cellule fusionnée vers une autre de même taille. Pour une raison quelconque, le fait de définir destRange sur l'ensemble de la plage (la plage entière de copy cell et pastecell, comme l'indiquait l'enregistreur de macro) n'a pas fonctionné, mais le fait de définir destRange sur la plage de cellules nécessitant un formatage, puis d'effectuer une union de cCell et destRange a fonctionné et a permis de nommer plus facilement la nouvelle plage.

rangeName = "Friday" & CStr(y + 1)
priorRangeName = "Friday" & CStr(y)
namedRangeExist = CheckForNamedRange(rangeName)
If namedRangeExist = False Then
    Set cCell = Range(priorRangeName) 
    Set destRange = Range(cCell.offset(1, 0).Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)
    cCell.AutoFill Destination:=Union(cCell, destRange), Type:=xlFillFormats
    Application.CutCopyMode = False
    destRange.Name = rangeName
End If

Mise à jour n°2

Il y a un problème avec le nommage des plages dans une boucle For (le code ci-dessous est exécuté dans une boucle For). La première fois que le nouveau nom de plage n'est pas trouvé, le fait de définir cCell sur le nom de la plage précédente et d'exécuter le code pour copier le format de cellule fusionné et nommer la nouvelle plage fonctionne bien. Voici le code

rangeName = "Thursday" & CStr(y + 1)
priorRangeName = "Thursday" & CStr(y)
namedRangeExist = DoesNamedRangeExist(rangeName)
If namedRangeExist = False Then
    Set cCell = Range(priorRangeName)
    Debug.Print "cCell:" & cCell.Address
    Set cCell = cCell.MergeArea
    Debug.Print "Merged cCell:" & cCell.Address
    Set destRange = Range(cCell.offset(1, 0).Address & ":" & cCell.offset(2, 0).offset(0, 1).Address)
    Debug.Print "Dest:" & destRange.Address
    Debug.Print "Unioned:" & Union(cCell, destRange).Address
    cCell.AutoFill Destination:=Union(cCell, destRange), Type:=xlFillFormats
    Application.CutCopyMode = False
    destRange.name = rangename
End If

donne les résultats suivants

cCell:$G$22

Fusionné cCell:$G$22:$H$23

Dest:$G$24:$H$25

Syndiqué:$G$22:$H$25

mais si plus d'une nouvelle plage nommée doit être créée la deuxième fois, ce code produit une zone de plage comme le montre le résultat ci-dessous.

cCell:$G$24:$H$25

Pourquoi l'adresse de cCell n'est affichée que dans la cellule supérieure gauche lors de la première exécution, alors que lors de la deuxième exécution, l'adresse de cCell est affichée dans toute la plage de cellules fusionnées ? Et parce que c'est le cas, la ligne de code suivante produit une erreur d'objet de plage.

Set cCell = cCell.MergeArea

En éliminant cette ligne de code et en modifiant le premier Set cCell en ceci ;

Set cCell = Range(priorRangeName).MergeArea

produit la même erreur. Je pourrais contourner ce problème en définissant un compteur et, s'il y en a plus d'un, contourner cette ligne de code, mais ce n'est pas la solution préférée.

Answer 1

Avant tout, créez une fonction pour appeler la gamme nommée. Si l'appel de la plage nommée génère une erreur, la fonction renverra False, sinon elle renverra True.

Function NameExist(StringName As String) As Boolean
    Dim errTest As String

    On Error Resume Next

    errTest = ThisWorkbook.Names(StringName).Value

    NameExist = CBool(Err.Number = 0)

    On Error GoTo 0
End Function

Pour ce qui est de votre deuxième question, je n'ai eu aucun problème avec le remplissage automatique.

Je remplacerais Set destRange = Range(cCell.Address & ":" & cCell.offset(2, 0).offset(0, 1).Address) con Set destRange = cCell.Resize(2,1) . Il a le même effet mais le second est beaucoup plus propre.

Answer 2

Le moyen le plus efficace est de ne pas vérifier s'il existe. Au lieu de cela, vous pouvez simplement ignorer l'erreur et continuer :

 On Error GoTo label1
   ' your code here
 label1:
 If Err.Number <> 0 Then Debug.Print Err.Description ' optional if you want to check the error
 On Error GoTo 0  ' to reset the On Error GoTo label1

Pour obtenir la plage de la cellule fusionnée, vous pouvez utiliser cCell.MergeArea
https://msdn.microsoft.com/en-us/library/office/ff822300.aspx

Answer 3

J'ai trouvé ceci sur ozgrid et en a fait une petite fonction :

Option Explicit

Function DoesNamedRangeExist(VarS_Name As String) As Boolean
Dim NameRng As Name

For Each NameRng In ActiveWorkbook.Names
    If NameRng.Name = VarS_Name Then
        DoesNamedRangeExist = True
        Exit Function
    End If
Next NameRng

DoesNamedRangeExist = False
End Function

Vous pouvez mettre cette ligne dans votre code pour vérifier :

DoesNamedRangeExist("Monday1")

Elle renvoie une valeur booléenne (Vrai / Faux), ce qui permet de l'utiliser facilement avec un fichier de type IF() déclaration

Pour ce qui est de votre question sur les cellules fusionnées, j'ai effectué un rapide enregistrement macro sur une cellule fusionnée 2*2 et cela m'a donné ceci (réduit et ajouté des commentaires) :

Sub Macro1()
    Range("D2:E3").Copy 'Orignal Merged Cell
    Range("G2").PasteSpecial xlPasteAll 'Top left of destination
End Sub

Answer 4

J'ai créé une fonction pour étendre les plages de noms et remplir le formatage. La première plage de noms de la série devra être configurée. Le nom lui-même doit être défini dans la cellule supérieure gauche de la zone fusionnée.

ExtendFillNamedRanges calculera les positions des plages nommées. Si une cellule dans l'une des positions ne fait pas partie d'une MergedArea, elle remplira le formatage vers le bas à partir de la dernière plage nommée. Cette cellule sera nommée. La portée des noms est Workbook.

Sub ExtendFillNamedRanges(BaseName As String, MaxCount As Integer)
    Dim x As Integer, RowCount As Integer, ColumnCount As Integer

    Dim LastNamedRange As Range, NamedRange As Range

    Set NamedRange = Range(BaseName & 1)

    RowCount = NamedRange.MergeArea.Rows.Count
    ColumnCount = NamedRange.MergeArea.Columns.Count

    For x = 2 To MaxCount
        Set NamedRange = NamedRange.Offset(RowCount - 1)
        If Not NamedRange.MergeCells Then
            Set LastNamedRange = Range(BaseName & x - 1).MergeArea
            LastNamedRange.AutoFill Destination:=LastNamedRange.Resize(RowCount * 2, ColumnCount), Type:=xlFillDefault
            NamedRange.Name = BaseName & x

        End If

        'NamedRange.Value = NamedRange.Name.Name
    Next

End Sub

Voici le test que j'ai effectué.

Sub Test()
    Application.ScreenUpdating = False
    Dim i As Integer, DayName As String

    For i = 1 To 7
        DayName = WeekDayName(i)

        Range(DayName & 1).Value = DayName & 1

        ExtendFillNamedRanges DayName, 10
    Next i

    Application.ScreenUpdating = True
End Sub

Avant :

Après :