XL 2010 [RESOLU] Créer feuilles à partir Dico

cp4

XLDnaute Barbatruc
Bonjour,

Je suis un peu perdu. Je récupère dans un dictionnaire la colonne E, représentant le nom des feuilles existantes ou à créer.
VB:
Sub CréerFeuillesManquantes()
   Dim dl As Long, cle As Variant, Wgl As Worksheet, dico As Object, a(), i As Long, ws As Worksheet
   Set dico = CreateObject("scripting.dictionary")
   Set Wgl = ThisWorkbook.Worksheets("BD")
   With Wgl
'récupérer colonne E sans doublons --> représentant noms onglets
      a = .Range("E2:E" & .Range("A" & Rows.Count).End(xlUp).Row)
      For i = LBound(a) To UBound(a)
         If a(i, 1) <> "" Then dico(a(i, 1)) = ""
      Next i

      For Each ws In ThisWorkbook.Worksheets
         For Each cle In dico.Keys
            ' créer feuille si n'existe pas
         Next cle
      Next ws
   End With
End Sub
Mon problème réside dans les boucles sur le dico et les feuilles pour vérifier l'existence des feuilles et créer celles qui n'existent pas.
En espérant avoir bien exposé mon problème.
En vous remerciant par avance.
Bonne journèe.
 

kiki29

XLDnaute Barbatruc
Salut, à tester
VB:
Function FeuilleExiste(sFeuille As String) As Boolean
    FeuilleExiste = Evaluate("ISREF('" & sFeuille & "'!A1)")
End Function

Code:
Function FeuilleExiste(sClasseur As String, sFeuille As String) As Boolean
Dim v As Variant
    v = Evaluate("ISREF('[" & sClasseur & "]" & sFeuille & "'!A1)")
    FeuilleExiste = IIf(IsError(v), False, v)
End Function
 

cp4

XLDnaute Barbatruc
Salut, à tester
VB:
Function FeuilleExiste(sFeuille As String) As Boolean
    FeuilleExiste = Evaluate("ISREF('" & sFeuille & "'!A1)")
End Function

Code:
Function FeuilleExiste(sClasseur As String, sFeuille As String) As Boolean
Dim v As Variant
    v = Evaluate("ISREF('[" & sClasseur & "]" & sFeuille & "'!A1)")
    FeuilleExiste = IIf(IsError(v), False, v)
End Function
Bonjour Kiki29;),

J'ai trouvé pas mal de codes dont ces 2 fonctions que je suis pas parvenu à utiliser.
En effet, je trouve des difficultés à utiliser les valeurs du dico comme nom de feuille.

Merci quand même pour la rapidité de ta réponse.

Bonne journée.
 

kiki29

XLDnaute Barbatruc
Salut, à la louche, à toi de poursuivre
VB:
Option Explicit

Function FeuilleExiste(sClasseur As String, sFeuille As String) As Boolean
Dim v As Variant
    v = Evaluate("ISREF('[" & sClasseur & "]" & sFeuille & "'!A1)")
    FeuilleExiste = IIf(IsError(v), False, v)
End Function

Sub Test()
Dim Wgl As Worksheet, LastRow As Long, i As Long
    Set Wgl = ThisWorkbook.Worksheets("BD")
    LastRow = Wgl.Range("E" & Rows.Count).End(xlUp).Row
    Application.ScreenUpdating = False
    For i = 2 To LastRow
        If FeuilleExiste(ThisWorkbook.Name, Wgl.Cells(i, 5)) = False Then
            Sheets.Add
            With ActiveSheet
                .Move After:=Sheets(ThisWorkbook.Worksheets.Count)
                .Name = Wgl.Cells(i, 5)
            End With
        End If
    Next i
    Wgl.Select
    Application.ScreenUpdating = True
End Sub
 
Dernière édition:

cp4

XLDnaute Barbatruc
Salut, à la louche, à toi de poursuivre
VB:
Option Explicit

Function FeuilleExiste(sClasseur As String, sFeuille As String) As Boolean
Dim v As Variant
    v = Evaluate("ISREF('[" & sClasseur & "]" & sFeuille & "'!A1)")
    FeuilleExiste = IIf(IsError(v), False, v)
End Function

Sub Test()
Dim Wgl As Worksheet, LastRow As Long, i As Long
    Set Wgl = ThisWorkbook.Worksheets("BD")
    LastRow = Wgl.Range("E" & Rows.Count).End(xlUp).Row
    For i = 2 To LastRow
        If FeuilleExiste(ThisWorkbook.Name, Wgl.Cells(i, 5)) = False Then
            Sheets.Add
            ActiveSheet.Move After:=Sheets(ThisWorkbook.Worksheets.Count)
            ActiveSheet.Name = Wgl.Cells(i, 5)
        End If
    Next i
End Sub
@kiki29 : Merci beaucoup. Pas exactement mes attentes. Ta proposition va boucler sur toutes les valeurs de la colonne 5, Alors que j'ai récupèré les valeurs de la colonne sans doublons dans un dico pour raccourcir le temps d’exécution. Merci quand même. Je vais essayer de m'en sortir.
 

cp4

XLDnaute Barbatruc
J'ai trouvé une partie de mon bonheur en utilisant mon ridicule dico
VB:
Option Explicit

Sub CréerFeuillesManquantes()
   Dim dl As Long, cle As Variant, Wgl As Worksheet, dico As Object, a(), i As Long, ws As Worksheet
   Set dico = CreateObject("scripting.dictionary")
   Set Wgl = ThisWorkbook.Worksheets("Grand livre")
   With Wgl
      'récupérer colonne E sans doublons --> représentant noms onglets
      a = .Range("E2:E" & .Range("A" & Rows.Count).End(xlUp).Row)
      For i = LBound(a) To UBound(a)
         If a(i, 1) <> "" Then dico(a(i, 1)) = ""
      Next i

      For Each cle In dico.Keys
         Debug.Print cle
         If SheetExist(CStr(cle)) Then
            MsgBox cle & " trouvée!"
         Else
            MsgBox cle & " non trouvée!"
         End If
      Next cle
   End With
End Sub

Public Function SheetExist(nom As String) As Boolean
   Dim ws As Worksheet
   SheetExist = False
   For Each ws In ThisWorkbook.Sheets
      If ws.Name = nom Then SheetExist = True: Exit For
   Next ws
End Function
 

patricktoulon

XLDnaute Barbatruc
re
bonjour cp4 je vais être moins dur que kiki mais en effet que viens faire un dico dans cette histoire
d'autant plus que tu te sert d'une des methode existe apres alors a quoi cela te sert de les collectionner dans un dico o_O o_O o_O o_O o_O o_O o_O o_O o_O
tout simplement
VB:
With Wgl
        'récupérer colonne E sans doublons --> représentant noms onglets
        A = .Range("E2", .Cells(Rows.Count, "E").End(xlUp)).Value
        For i = LBound(A) To UBound(A)
            If TypeName(Evaluate(A(i, 1) & "!A:A")) <> "Range" Then
                Set sh = Sheets.Add    'voir les arguments pour un eventuel placement dans un ordre défini
                sh.Name = A(i, 1)
            End If
        Next i
    End With
et les doublons sont exeptés;)
 

cp4

XLDnaute Barbatruc
re
bonjour cp4 je vais être moins dur que kiki mais en effet que viens faire un dico dans cette histoire
d'autant plus que tu te sert d'une des methode existe apres alors a quoi cela te sert de les collectionner dans un dico o_O o_O o_O o_O o_O o_O o_O o_O o_O
tout simplement
VB:
With Wgl
        'récupérer colonne E sans doublons --> représentant noms onglets
        A = .Range("E2", .Cells(Rows.Count, "E").End(xlUp)).Value
        For i = LBound(A) To UBound(A)
            If TypeName(Evaluate(A(i, 1) & "!A:A")) <> "Range" Then
                Set sh = Sheets.Add    'voir les arguments pour un eventuel placement dans un ordre défini
                sh.Name = A(i, 1)
            End If
        Next i
    End With
et les doublons sont exeptés;)
Merci PatrickToulon ;),

Merci, pour ta proposition que je vais étudier et tester avec un grand intérêt.
Sans aucune explication de la part de kiki29, j'ai trouvé ça décevant et démoralisant.
Ah, si j'avais votre expérience et connaissances, je ne serai pas entrain de quémander une quelconque aide. Mais bon! ça reflète mon niveau. Avec ma petite cervelle, je me suis dis à quoi bon parcourir plus de 60 000 lignes (dont une masse des valeurs sont des doublons) pour finalement ne créer que quelques feuilles manquantes, d'où mon idée d'utiliser un dictionnaire.

Je me permets de vous dire que depuis l'arriver de certains anciens de chez le Belge. Les interventions deviennent un peu moqueuses. J'espère que ce forum restera sain comme à ses débuts, et ce durant un bon bout de temps.

Je vous remercie beaucoup. Les bleus comme moi, vous seront toujours reconnaissants.
 

patricktoulon

XLDnaute Barbatruc
re
(dont une masse des valeurs sont des doublons) pour finalement ne créer que quelques feuilles manquantes, d'où mon idée d'utiliser un dictionnaire.
réfléchi 1 seconde ;):p
tu les parcours quand même pour alimenter ton dico ;)

Je me permets de vous dire que depuis l'arriver de certains anciens de chez le Belge. Les interventions deviennent un peu moqueuses

j'ai eu en effet remarqué un changement de comportement de certains depuis en en effet ;)

il semblent allergique aux novices et semblent avoir perdu de vu qu'un jour c'est eux qui ont posé des questions """"idiotes""""

moi meme quand il m'arrive de perdre de vue ce point je m'en vais voir mes questions de mes debuts en 2009 sur ""chez le belge"" et je suis le premier à en rire
ça fait du bien des fois de redescendre ;)
 
Dernière édition:

cp4

XLDnaute Barbatruc
re

réfléchi 1 seconde ;):p
tu les parcours quand même pour alimenter ton dico ;)



j'ai eu en effet remarqué un changement de comportement de certains depuis en en effet ;)

il semblent allergique aux novices et semblent avoir perdu de vu qu'un jour c'est eux qui ont posé des questions """"idiotes""""

moi meme quand il m'arrive de perdre de vue ce point je m'en vais voir mes questions de mes debuts en 2009 sur ""chez le belge"" et je suis le premier à en rire
ça fait du bien des fois de redescendre ;)
Re Patrick ;),

J'ai testé ton code. Il fonctionne bien. Comme, je voudrais dormir ce soir moins idiot. J'ai cherchéà comprendre ta ligne de code suivante
VB:
If TypeName(Evaluate(a(i, 1) & "!A:A")) <> "Range" Then
L'aide me dit que TypeName :
TypeName, fonction
Renvoie une valeur de type String qui fournit des informations sur une Lien supprimé
Ensuite, je n'ai pas du tout compris Evaluate(a(i, 1) & "!A:A")
En d'autres termes, je n'ai pas compris grand chose à ta ligne de code.
Pourrais-tu me l'expliquer? Merci.

Bonne soirée.
 

patricktoulon

XLDnaute Barbatruc
re

et bien sur que c'est un string mais le string du type pas de l'object

TypeName(Evaluate(a(i, 1) & "!A:A")) <> "Range" Then

traduction
SI le type du résultat de l’évaluation de "a(i, 1) & "!A:A")" est "Range" alors

en gros soit c'est error soit c'est range

si je demande le type de sheets(a(i,1)).range("A:A") et qu'il me retourne "Range" ça veut dire que le sheets existe sinon ben ça veut dire que le sheets n'existe pas
l'avantage de evaluate c'est que l'erreur n'est pas bloquante
et donc pas besoins de gerer avec "on error resume next" et autres cochonneries
 

cp4

XLDnaute Barbatruc
re

et bien sur que c'est un string mais le string du type pas de l'object

TypeName(Evaluate(a(i, 1) & "!A:A")) <> "Range" Then

traduction
SI le type du résultat de l’évaluation de "a(i, 1) & "!A:A")" est "Range" alors

en gros soit c'est error soit c'est range

si je demande le type de sheets(a(i,1)).range("A:A") et qu'il me retourne "Range" ça veut dire que le sheets existe sinon ben ça veut dire que le sheets n'existe pas
l'avantage de evaluate c'est que l'erreur n'est pas bloquante
et donc pas besoins de gerer avec "on error resume next" et autres cochonneries
Bonjour Patrick ;),
Toute ma gratitude et ma reconnaissance. Tes explications sont très claires.
Ce qui m'a dérouté c'est que dans Evaluate, il n'y a pas Sheets.
En fait, je n'avais pas compris ce qu'allait retourner Evaluate. J'ai essayé de transcrire en formule dans une cellule pour mieux comprendre. Mais, je j'ai pas trouvé dans les formules l'equivalence de Evaluate.

Merci beaucoup pour ton aide et tes explications. J'ai appris avec toi comment créer des feuilles sans gestion d'erreurs. Devant transférer des données de ma feuille BD dans les différentes feuilles créées. Le seul souci est que des fois certaines feuilles existent déjà. Ne te tracasse pas pour ça, je vais finir par trouver une solution. D'autant plus que je n'ai aucune contrainte de temps, c'est pour mon apprentissage du vba.

Bonne journée.
 
Dernière édition:

Discussions similaires

Réponses
12
Affichages
225

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T