Remplacer l'objet dictionnaire pour compatibilité avec mac

[Psycolab]

Bonjour à tous,

En voulant tester ma macro sur un mac (office 2011) hier soir, j'ai appris que certaines fonctions en VBA ne sont pas compatible avec mac ! J'ai fait une macro pour le boulot et une partie des utilisateurs sont sous mac, ce qui rend complétement inutile tout le travail réalisé jusqu’à présent. Il est vrai que j'aurai du me poser la question au début mais je suis à mes tout débuts en VBA et pour moi du VBA sous exel etait du VBA et ce peut importe la plateforme (douce illusion !). Bref voici mon problème :

Ma macro repose sur un dictionnaire car c'est la seule méthode que j'ai trouvé pour créer une liste dans laquelle j'ai éliminé les doublons et la macro crée ensuite un onglet par Item (dictionnaire) d'où la nécessité de ne pas avoir de doublons.

Je suis à la recherche de toutes solutions permettant de remplacer le dictionnaire par une autre fonction sans pour autant que le temps d'exécution soit augmenté car la création des onglets est juste une étape préliminaire dans la macro. Bien entendu il faut que la fonction de remplacement soit compatible sous mac.

Je remercie par avance ceux qui prendront le temps de lire mon problème.

Vous trouverez un exemple en pièce jointe.

amicalement,

Nico

 

[Staple1600]

Re : Remplacer l'objet dictionnaire pour compatibilité avec mac

Bonjour à tous

Psycholab:
Passe le filtre élaboré (piloté par VBA) pour créer une liste sans doublons.
Rassures-moi le filtre élaboré existe bien sur Mac?

 

[Staple1600]

Re : Remplacer l'objet dictionnaire pour compatibilité avec mac

Re


Je viens de tester avec succès (mais sur un PC) ce qui suit

Sub a()
Dim ws As Worksheet
Dim r As Range, c As Range, cl&, i&, j&
Dim t() As Variant
i = 0
Set ws = Feuil1
Application.ScreenUpdating = False
Set r = ws.Range(ws.[A1], ws.[A65536].End(xlUp))
r.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
cl = r.SpecialCells(xlCellTypeVisible).Count - 1
ReDim t(cl)
For Each c In r.SpecialCells(xlCellTypeVisible)
t(i) = c.Value
i = i + 1
Next c
For j = 1 To UBound(t)
Sheets.Add(After:=Sheets(Sheets.Count)).Name = t(j)
Next j
ws.ShowAllData
End Sub

PS: Sur la feuille 1, en colonne A, le noms des onglets à créer avec en A1 un entête.
(Mettre des noms en doublons pour faire le test)

 

[Psycolab]

Re : Remplacer l'objet dictionnaire pour compatibilité avec mac

Salut,

Il y a 5 min encore je ne connaissais pas les filtres élaborés, je vais creuser car ça à l'air inintéressant et je vais voir comment virer les doublons (si tu veux bien me donner quelques exemple d'utilisation je suis preneur car mon niveau de VBA est débutant.)
Par contre étant un individu sain d’esprit je n'ai pas de mac (dsl pour les possesseur de mac mais c'est la frustration qui parle !) et je n'ai pas la moindre idée de ce qu'il y a comme fonction dans Exel sur mac, d’où mon problème. Par contre d'après ce que j'ai lu la version exel 2008 (mac) ne prendrais même pas le VBA. Je ne suis pas un expert mais de ce que j'ai vu tous les objets qui passe par les contrôles Active X ne sont pas pris en charge car mac n'utilise pas les contrôles active X. N'étant pas informaticien, toute ces notions sont assez flou pour moi donc à confirmer.
Avis au possesseur de mac quelles commandes sont à proscrire ?

Merci pour ta réponse Staple 1600.

 

[Staple1600]

Re : Remplacer l'objet dictionnaire pour compatibilité avec mac

Re,

Le filtre élaboré permet déjà de filtrer sans doublons en cochant (je te le donne en mille)
[X] Extraction sans doublons

Fais un test de la macro précédente (ou lances celle-ci de suite à partir d'un classeur vierge)

Sub ab()
Dim ws As Worksheet
Dim r As Range, c As Range, cl&, i&, j&
Dim t() As Variant
i = 0
Set ws = Feuil1
ws.Cells.Clear
'/////ajout pour création test
ws.[A1] = "NOMS ONGLETS"
ws.[A2:A10] = Application.Transpose(Array(1, 2, 2, 3, 3, 3, 4, 5, 5))
Application.ScreenUpdating = True
MsgBox "Lancer la création des onglets sans doublons?", 64, "TEST"
'/////fin ajout
Application.ScreenUpdating = False
Set r = ws.Range(ws.[A1], ws.[A65536].End(xlUp))
r.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
cl = r.SpecialCells(xlCellTypeVisible).Count - 1
ReDim t(cl)
    For Each c In r.SpecialCells(xlCellTypeVisible)
    t(i) = c.Value
    i = i + 1
    Next c
    For j = 1 To UBound(t)
    Sheets.Add(After:=Sheets(Sheets.Count)).Name = t(j)
    Next j
ws.ShowAllData
ws.Activate
End Sub

 

[Psycolab]

Re : Remplacer l'objet dictionnaire pour compatibilité avec mac

Ok merci je me penche dessus et je te tiens au courant.

 

[BOISGONTIER]

Re : Remplacer l'objet dictionnaire pour compatibilité avec mac

Bonjour,

Si le nombre d'items à gérer n'est pas important, il y a l'objet collection

Objet collection

On peut également le simuler avec un module de classe


Création de classe

http://boisgontierjacques.free.fr/fichiers/Cellules/ClasseDictionnaireCollection.xls

Sub essaitab()
   Set a = New Tableau
   a.Nbelem = 0
   For i = 1 To 1000
     a.ajoutSansDoublons = Int(Rnd * 10000)
   Next i
   t = Timer
   x = a.triTable                ' tri 0,03 secondes
   MsgBox Timer - t
   MsgBox a.count & " Eléments"
   x = a.affiche
End Sub

Module de classe tableau

Private table()
Private xn
Public Property Let Nbelem(n)
  xn = n
End Property

Public Property Let ajoutSansDoublons(el)
  témoin = False
  For i = 1 To xn
    If el = table(i) Then témoin = True
  Next i
  If Not témoin Then
    xn = xn + 1
    ReDim Preserve table(xn)
    table(xn) = el
  End If
End Property

Public Property Let ajout(el)
   xn = xn + 1
   ReDim Preserve table(xn)
   table(xn) = el
End Property

Public Property Get affiche()
  For i = 1 To xn
    MsgBox table(i)
  Next i
End Property

Public Property Get triTable()
 ecart = xn     ' tri shell
 Do While ecart >= 1
   ecart = ecart \ 2
   inv = True
   Do While inv
        inv = False
        For i = 1 To xn - ecart
          j = i + ecart
          If table(i) > table(j) Then
             temp = table(j)
             table(j) = table(i)
             table(i) = temp
             inv = True
          End If
        Next
    Loop
 Loop
End Property

Public Property Get count()
  count = xn
End Property

jb

 

[Psycolab]

Re : Remplacer l'objet dictionnaire pour compatibilité avec mac

Bon j'ai fait des test et ton code marche très bien mais un bug apparaît si les doublons ne se suivent pas.

code VBA :

Sub ab()
Dim ws As Worksheet
Dim r As Range, c As Range, cl&, i&, j&
Dim t() As Variant
i = 0
Set ws = Feuil1
ws.Cells.Clear
'/////ajout pour création test
ws.[A1] = "NOMS ONGLETS"
ws.[A2:A12] = Application.Transpose(Array(1, 2, 2, 3, 3, 3, 4, 5, 5, 1, 1))
Application.ScreenUpdating = True
MsgBox "Lancer la création des onglets sans doublons?", 64, "TEST"
'/////fin ajout
Application.ScreenUpdating = False
Set r = ws.Range(ws.[A1], ws.[A65536].End(xlUp))
r.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
cl = r.SpecialCells(xlCellTypeVisible).Count - 1
ReDim t(cl)
For Each c In r.SpecialCells(xlCellTypeVisible)
t(i) = c.Value
i = i + 1
Next c
For j = 1 To UBound(t)
Sheets.Add(After:=Sheets(Sheets.Count)).Name = t(j)
Next j
ws.ShowAllData
ws.Activate
End Sub


J'ai juste rajouté des doublons déjà rencontré en amont et il y a un message d'erreur me disant qu'il ne peut pas ajouter un onglet qui porte déjà ce nom. Au vu de l'utilisation que je veux en faire malheureusement, ça ne passera pas.

 

[Psycolab]

Re : Remplacer l'objet dictionnaire pour compatibilité avec mac

Salut Boisgontier,

La collection ne fera pas l'affaire car j'aurai beaucoup d'élément à traiter et concernant les modules de classes, j'ai regardé un peu ce que tu m'as envoyé mais j'ai du mal a voir les applications, je suis trop novice encore. Pourrais tu développé un peu leurs l'utilisation et leurs applications stp.

 

[Staple1600]

Re : Remplacer l'objet dictionnaire pour compatibilité avec mac

Re


Cela fonctionne (pas encore à 100%, je te laisse découvrir ce qui peut coincer )
Pour tester, créée toi-même sur une feuille en colonne A, des noms d'onglets à créer avec des doublons
puis lance la macro plusieurs fois, tu verras que le message d'erreur dont tu parlais n’apparaît pas.

Sub abc()
Dim ws As Worksheet
Dim r As Range, no As Range, c As Range, x As Range, cl&, i&, j&, t() As Variant
i = 0: Set ws = Feuil1
Application.ScreenUpdating = False
Set r = ws.Range(ws.[A1], ws.[A65536].End(xlUp))
r.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set x = ws.[_FilterDataBase]
cl = r.SpecialCells(12).Count - 1
Set no = x.Offset(1, 0).Resize(x.Rows.Count - 1).SpecialCells(12)
ReDim t(cl)
    For Each c In no
        t(i) = c.Value
        i = i + 1
    Next c
    For j = 0 To UBound(t) - 1
        If Not ExisteF(t(j)) Then
        Sheets.Add(After:=Sheets(Sheets.Count)).Name = t(j)
        End If
    Next j
ws.ShowAllData: ws.Activate
End Sub

Private Function ExisteF(F) As Boolean ' adapté de jw
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(F)
ExisteF = (Err = 0)
End Function

PS: Test OK chez moi sauf dans un cas particulier

 

[Psycolab]

Re : Remplacer l'objet dictionnaire pour compatibilité avec mac

Je vais tester ta proposition et voir si je trouve le bug lol. Au moins c'est formateur, c'est déjà ça.

Sinon sur exel 2010 il y a une fonction qui permet d'éliminer les doublons du coup j'essayais de l'adapter avec l'enregistreur de macro mais j'ai bien peur que ce genre de passe passe ne passe pas sur mac (Grrr). Quand je pense que ma macro complete fonctionne bien sur PC, ça me tue de devoir tout me retaper pour l'adapter à mac !

Phrase fétiche d'apple : Nous c'est la pomme et eux (nos clients) c'est la poire !

En tout cas je te remercie du coup de main

 

[Dranreb]

Re : Remplacer l'objet dictionnaire pour compatibilité avec mac

Bonsoir.
Je trouve un peu bizarre qu'il n'existe pas sous Mac l'équivalent de la référence "Microsoft Scripting Runtime". Ça veut dire qu'on ne peut utiliser non seulement les Dictionary, mais non plus les Drive, Drives, Encoder, File, Files, FileSystemObject, Folder, Folders, TextStream, ni une cinquantaine de méthodes en tout, et autant de propriétés attachées à ces objets. Ça fait beaucoup je trouve. Je sais que si j'étais personnellement dans votre cas je m'attaquerais très certainement à l'écriture, carrément, de la classe Dictionary avec exactement les mêmes méthodes et propriétés !
Cordialement.

 

[Staple1600]

Re : Remplacer l'objet dictionnaire pour compatibilité avec mac

RE, Bonsoir Dranreb

.
"Microsoft Scripting Runtime"..

Microsoft versus Apple, la guéguerre de toujours

Normal dans ces conditions, qu'Apple n'utilise pas le Microsoft Scripting Runtime, non ?

EDITION: Pour infos: Voir les essais de Ron avec VBA et MAC

 

[Psycolab]

Re : Remplacer l'objet dictionnaire pour compatibilité avec mac

Re

Bon ba ça marche impeccable, il y avait 2 bugs : ça ne marchait pas si il y avait qu'une seule valeur dans la colonne A et si il y en avait plusieurs il ne créait pas d'onglet avec le nom de A1. par ex A1 = 1; A2 = 2; A3= 3, il aurait créer que 2 onglets le n°2 et le 3. J'ai corrigé ces 2 petits problèmes, dis moi ce que tu en pense.

Comme tu l'as vu je débute en VBA et j'essaye de comprendre les codes que j'emprunte sur le net, et je dois t'avouer que je n'ai pas tout compris pour le tien, pourrais tu rajouter quelques commentaires pour que je comprenne bien le détail. Si tu as la flemme je comprendrais car tu m'as déjà beaucoup aidé.

Si tu le permets je vais également le poster sur une nouvelle discussion pour qu'une âme charitable possédant un mac test cette macro

Amicalement,
Nico

Code VBA :
Sub abc()
Dim ws As Worksheet
Dim r As Range, no As Range, c As Range, x As Range, cl&, i&, j&, t() As Variant
Dim m As Integer


Application.ScreenUpdating = False

If Range("A2").Value = Empty Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = Range("A1").Value

Else
i = 0: Set ws = Feuil1
Set r = ws.Range(ws.[A1], ws.[A65536].End(xlUp))
r.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set x = ws.[_FilterDataBase]
cl = r.SpecialCells(12).Count - 1
Set no = x.Offset(1, 0).Resize(x.Rows.Count - 1).SpecialCells(12)
ReDim t(cl)
For Each c In no
t(i) = c.Value
i = i + 1
Next c
Sheets.Add(After:=Sheets(Sheets.Count)).Name = Range("A1").Value
For j = 0 To UBound(t) - 1
If Not ExisteF(t(j)) Then
Sheets.Add(After:=Sheets(Sheets.Count)).Name = t(j)
End If
Next j
End If
'ws.ShowAllData: ws.Activate
End Sub


Private Function ExisteF(F) As Boolean ' adapté de jw
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(F)
ExisteF = (Err = 0)
End Function

 

[Staple1600]

Re : Remplacer l'objet dictionnaire pour compatibilité avec mac

Re


Commentions, commentons

Sub abc()
'Déclarations des variables
Dim ws As Worksheet
Dim r As Range, no As Range, c As Range, x As Range, cl&, i&, j&, t() As Variant
i = 0: Set ws = Feuil1
'Fige le rafraichissement écran
Application.ScreenUpdating = False
'Définit la plage de cellules non vides de la colonnes A (de la 1ère à la dernière cellule "utile")
Set r = ws.Range(ws.[A1], ws.[A65536].End(xlUp))
'Filtre élabore sans doublons
r.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
Set x = ws.[_FilterDataBase] ' Définit la plage filtrée
cl = r.SpecialCells(12).Count - 1 'compte le nombre de lignes du filtre - le titre
Set no = x.Offset(1, 0).Resize(x.Rows.Count - 1).SpecialCells(12)
'Définit la plage de cellules visibles du filtre - le titre
'Remplit l'Array
ReDim t(cl)
 For Each c In no
 t(i) = c.Value
 i = i + 1
 Next c
'Crée les onglets avec les noms présent dans l'Array
For j = 0 To UBound(t) - 1
If Not ExisteF(t(j)) Then 'vérifie la non existence de feuille avec noms présents dans Array
Sheets.Add(After:=Sheets(Sheets.Count)).Name = t(j) 'création des onglets
 End If
 Next j
'Désactivation du filtre et activation de la feuille 1
ws.ShowAllData: ws.Activate
End Sub