Problème fonction removeDuplicates sur classeur partagé

**bbosch** · 11/12/2017, 08h57

Bonjour à tous, j'ai créé une macro qui me permet de faire une espèce d’extraction de donnée dans un autre fichier, tout fonctionnait jusqu’à ce que je mette mon fichier source en partage, j'ai pas mal cherché et il s’avère que c'est la fonction "removeDuplicates" qui ne passe pas en mode partagé.

Pourtant il n'est pas interdit de supprimer les lignes en partage, je ne comprend pas pourquoi cette fonction ne passe pas, est-il possible de contourner le problème ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
Sub MAJ201()
 'déclaration des variables
    Dim Fichier, rep1, rep2 As String 'chemin du fichier
    Dim shA, shB As Worksheet 'Feuille A
    Dim wB, wA As Workbook 'Classeur
    Dim lignevide, lignevide1, lignevide0, lignevidef1, lignevide2, lignevidef2, lignevide3, i, j, k, feuille As Integer 'compteur1
    
    Fichier = ThisWorkbook.Sheets("listes").Range("A2").Value
    On Error GoTo errorhandler
    
travail:
    Application.DisplayAlerts = False 'désactive les boites de dialogue
    Application.ScreenUpdating = False 'désactive la mise à jour de l'écran
    
    
    Set wB = Workbooks.Open(Filename:=Fichier) 'pointe le fichier que l'on va extraire
    
    On Error GoTo erreurGénérale
    
    Set shA = ThisWorkbook.Sheets("Data200")
    Set shB = wB.Sheets("Data201")
    
    'MAJ data
    lignevide0 = shB.Range("A" & Rows.Count).End(xlUp).Row + 1 'donne le numero de la premiere ligne vide du wb
    lignevide1 = shA.Range("A" & Rows.Count).End(xlUp).Row + 1
   
  shB.Range("A4", "S" & lignevide0).Copy Destination:=shA.Range("a" & lignevide1)
      lignevidef1 = shA.Range("A" & Rows.Count).End(xlUp).Row + 1
    
    shA.Range("A4", "S" & lignevidef1).RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo 'supprime les doublons
    For ligne = 4 To lignevidef1 Step 1
    If IsEmpty(shA.Range("A" & ligne)) Then
       shA.Rows(ligne & ":" & ligne).Delete
       End If
       Next ligne
    
    shA.Columns.AutoFit 'ajuste les colonnes au texte
    
    'MAJ rapport responsable
    lignevide2 = wB.Sheets("Rapport responsable").Range("A" & Rows.Count).End(xlUp).Row + 1 'donne le numero de la premiere ligne vide du wb
    lignevide3 = ThisWorkbook.Sheets("Items importants").Range("A" & Rows.Count).End(xlUp).Row + 1
   
    wB.Sheets("Rapport responsable").Range("A5", "S" & lignevide2).Copy Destination:=ThisWorkbook.Sheets("Items importants").Range("a" & lignevide3)
      lignevidef2 = ThisWorkbook.Sheets("Items importants").Range("A" & Rows.Count).End(xlUp).Row + 1
      
    wB.Close False ' ferme sans sauve
    
    ThisWorkbook.Sheets("Items importants").Range("A4", "A" & lignevidef2).CurrentRegion.RemoveDuplicates Columns:=Array(1, 2), Header:=xlNo 'supprime les doublons
    
    ThisWorkbook.Sheets("Items importants").Columns.AutoFit 'ajuste les colonnes au texte
    
    For ligne = 4 To lignevidef2 Step 1
    If IsEmpty(shA.Range("A" & ligne)) Then
       shA.Rows(ligne & ":" & ligne).Delete
       End If
       Next ligne
   
    Application.DisplayAlerts = True 'réactive les boites de dialogue
     
    Exit Sub

errorhandler:
    If IsEmpty(Fichier) Then
    Fichier = "Chemin d'acces vide"
    End If
  rep1 = MsgBox("Le fichier est introuvable, le chemin enregistré actuellement est :" & vbLf & vbLf & Fichier & vbLf & vbLf & "Voulez vous le modifier ?", vbYesNo + vbCritical, "Erreur chemin fichier à extraire (UAP202)")
        If rep1 = vbYes Then
changementFichier:
         Fichier = Application.GetOpenFilename("Tous les fichiers (*.*),*.*") 'Affiche la boîte de dialogue "Ouvrir" et ouvre le fichier selectionné
        ThisWorkbook.Sheets("listes").Range("A2") = Fichier
        GoTo travail
    End If
        If rep1 = vbNo Then
        wB.Close False
    Exit Sub
    End If

erreurGénérale:
    rep2 = MsgBox("Assurez vous de la bonne structure des fichier d'émission et de reception, si le problème persiste contactez l'administrateur." & vbLf & vbLf & "Voulez-vous changer l'emplacement du fichier ?", vbYesNo + vbCritical, "Erreur compilation (UAP201)")
    If rep2 = vbYes Then
    GoTo changementFichier
    End If
     If rep2 = vbNo Then
     wB.Close False
    End If
End Sub

**Menhir** · 11/12/2017, 10h15

Envoyé par bbosch

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
    On Error GoTo errorhandler
    Application.DisplayAlerts = False 'désactive les boites de dialogue
    Application.ScreenUpdating = False 'désactive la mise à jour de l'écran

Tu fais vraiment le maximum pour que empêcher de voir la source du problème.

**bbosch** · 11/12/2017, 10h27

Envoyé par Menhir

Tu fais vraiment le maximum pour que empêcher de voir la source du problème.

J'ai fait un maximum pour gérer les erreurs quand le fichier sera utilisé par une personne qui ne connait rien en VBA.

Je met tout ça en commentaire pour tester le programme. C'est pour ça que je sais que c'est la ligne qui contient le removeDuplicate qui ne passe pas quand je met le classeur en partage.

**patricktoulon** · 11/12/2017, 11h00

partagé
ce qui veux dire que le 2d utilisateur qui ouvre le fichier puis tout les suivants ouvrent le fichier en readonly

tu vois ce que je veux dire ?

**bbosch** · 11/12/2017, 11h20

Envoyé par patricktoulon

partagé
ce qui veux dire que le 2d utilisateur qui ouvre le fichier puis tout les suivants ouvrent le fichier en readonly

tu vois ce que je veux dire ?

Quand le document est en partage tout le monde (enfin ceux autorisés à ecrire dans le dossier) pourra faire tourner cette macro et donc mettre à jour les deux onglets mais le problème c'est que je n'arrive pas à utiliser la fonction "removeDuplicate" quand je met le classeur en mode partage. Le reste fonctionne très bien quand je met cette ligne en commentaire.

Pourtant en partage on peut supprimer des lignes, c'est cela que je ne comprends pas très bien.

**patricktoulon** · 11/12/2017, 11h31

avant de tirer des conclusions attives a tu essayé avec une copie de ton classeur en local

**joe.levrai** · 11/12/2017, 11h32

Bonjour,

cette fonctionnalité étant inhibée lors d'un partage de classeur, c'est à toi de rédiger une procédure pour faire le job !

y'a des exemples facilement accessibles sur Google, et même au sein de ce forum qui propose pas moins de 3 ou 4 méthodes différentes

**bbosch** · 11/12/2017, 12h10

Envoyé par patricktoulon

avant de tirer des conclusions attives a tu essayé avec une copie de ton classeur en local

Oui j'ai essayé sur mon ordi en local et cela ne fonctionne pas non plus !

**bbosch** · 11/12/2017, 12h11

Envoyé par joe.levrai

Bonjour,

cette fonctionnalité étant inhibée lors d'un partage de classeur, c'est à toi de rédiger une procédure pour faire le job !

y'a des exemples facilement accessibles sur Google, et même au sein de ce forum qui propose pas moins de 3 ou 4 méthodes différentes

D'accord, je me doutais qu'excel avait encore limité ses capacités avec le partage... Dommage ! Je vais rédiger la fonction en espérant que cela ne prennent pas des siècles en l faisant tourner la macro...

Merci

**Menhir** · 11/12/2017, 12h50

Envoyé par bbosch

D'accord, je me doutais qu'excel avait encore limité ses capacités avec le partage...

On ne le répètera jamais assez : multi-utilisateurs ou (dans une moindre mesure) multi-fichiers = SGDB.
Très clairement, Excel n'est pas fait pour ça, même s'il est supposé disposer de fonctionnalités qui le permettent.

**bbosch** · 11/12/2017, 16h06

Pour info j'ai réussi à faire une fonction qui a la même fonctionnalité que le removeDuplicate, c'est a dire suppression de lignes si les deux premières cellules sont identiques (on peut faire avec plus) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
 
Function supprimerDoublons(ligne0 As Integer, lignevide1 As Integer, sht As Worksheet)
 
For D = ligne0 To lignevide1 Step 1
    For i = D + 1 To lignevidef Step 1
        If sht.Cells(i, 1).Value = sht.Cells(D, 1).Value And sht.Cells(i, 2).Value = sht.Cells(D, 2).Value And Not IsEmpty(sht.Cells(i, 1)) And Not IsEmpty(sht.Cells(i, 2)) Then
        sht.Rows(i & ":" & i).Delete
        lignevidef = lignevidef - 1
        i = i - 1
        Else
        End If
    Next i
Next D
 
End Function

Je l'ai testé et ça fonctionne bien, mais ça reste du bricolage.

Dans cette fonction il faut mettre dans ligne0 la ligne de départ du tableau et dans lignevidef la ligne vide a la fin du tableau (et non la dernière ligne du tableau) et bien sur déclarer avec sht l'endroit ou on veut mettre en pratique la formule.

Je ne l'ai pas fait dedans mais on pourrait calculer la dernière ligne directement dans la fonction...

Problème fonction removeDuplicates sur classeur partagé [XL-2010]

Macros et VBA Excel

Discussions similaires

Partager

Partager