Microsoft 365 Mon casse-tête depuis 1 semaine = je vais devenir maboul

Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Bonjour à toutes et à tous,
Je vous souhaite une beau WE :)

Voilà une semaine que je planche sur les 2 soucis de mon fichier.
Et là : c'est trop fort pour moi et je n'y comprends rien !!!

J'ai créé un fichier de prospection qui fonctionne parfaitement chez moi.
Je suis en Tunisie sous office365 - windows10
Ma collègue habite en France et est également : sous office365 - windows10
Ses paramètres office et windows10 sont exactement les mêmes que moi (y compris paramètres régionaux et complémentaires).

Et pourtant :mad::mad::mad:
Quand j'envoie le fichier (transfert par Skype) à ma collègue ... il ne fonctionne pas chez elle !!!

Fonctionnement du fichier :
A l'ouverture (code dans le ThisWorkbook) :
- les rappels de la colonne "J" à partir de la ligne 6 sont classés dans l'ordre des dates,
- Ils sont comptés. Un MsgBox s'affiche pour informer,
- les dates en dépassement ne sont mises en rouge (MFC) :
1634974829065.png

Problème 1
Chez ma collègue à l'ouverture il y a un souci d'incompatibilité type 13
1634974997929.png

Problème 2
Les rappels ne sont pas classés par dates mais classés sur les jours.
Et les dates en dépassement ne sont pas mises en rouge (MFC)
1634976735991.png

Je n'arrive pas à comprendre pourquoi :
Même fichier (fichier transmis) - même Windows10 - même office - même paramètres.
ça marche chez moi et pas chez elle :mad::mad::mad:

Je joins le fichier test.
nota : le code de la feuille permet également de trier en cliquant sur la cellule "J5" (classer)

Fonctionne-t-il chez vous ?
Pourriez tester et m'aider ?
Je vous remercie vivement,
Amicalement,
lionel,
 

Pièces jointes

  • Appel_test2.xlsm
    33.5 KB · Affichages: 25
Dernière édition:
Trier par date Trier par votes
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Bonjour à toutes et à tous,

Un grand MERCI à vous tous qui m'avez encore aidé et particulièrement à Yeahou :)
Après plusieurs jours d'utilisation, c'est confirmé, tout fonctionne très bien.
Mais je vois poindre un souci.
Voici le code de tri :
VB: 
Sub tri_rappels()
    ActiveSheet.Unprotect Password:=""
    Application.ScreenUpdating = False: Application.EnableEvents = False
    With ActiveSheet 'CodeName
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Rows("6:" & .Range("k65536").End(xlUp).Row)
        If .Row < 6 Then Exit Sub 'sécurité
        .Sort .Columns(11), xlAscending, Header:=xlNo
    End With
    End With
    
Dim c As Range, dl As Long, Tablo, Tablo2, I&
    dl = Cells(Rows.Count, "J").End(xlUp).Row
    With Range("j6:j" & dl)
        .NumberFormat = "dd/mm/yyyy" & vbLf & "hh:mm"
        Tablo = .Value2
        Tablo2 = Tablo
        On Error Resume Next
        For I = LBound(Tablo, 1) To UBound(Tablo, 1)
            Tablo2(I, 1) = Tablo(I, 1)
            Tablo2(I, 1) = CDate(Replace(Application.Trim(Tablo(I, 1)), ".", "/"))
        Next I
        On Error GoTo 0
        .Value = Tablo2
    End With
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=Range("J6:J" & dl), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
        .SetRange Range("a6:z" & dl)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    For Each c In Range("j6:j" & dl)
        If IsDate(c) Then
            'c.RowHeight = 30
            c.WrapText = True
        End If
    Next
    'Range([a6], Cells(Rows.Count, "a").End(xlUp)).RowHeight = 55
    [c1].Select
    ActiveWindow.ScrollRow = Selection.Row
    'MsgBox ("Vous avez" & " " & [o5] & " " & "rappels aujourd'hui et/ou dépassés !")
    Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub
A ce jour, pour 131 lignes il met environ 5 secondes pour s'exécuter.
Je me demande combien de temps il va mettre quand il y aura 10.000 lignes et plus dans le fichier ?

Est-il possible de raccourcir son temps d'exécution;
Si besoin, je ferai un fichier test.

Merci à vous encore une fois,
Amicalement,
lionel,
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bonjour Lionel, le fil,

Ce qui prend du temps c'est cette boucle :
VB: 
   For Each c In Range("j6:j" & dl)
        If IsDate(c) Then
            'c.RowHeight = 30
            c.WrapText = True
        End If
    Next
Il faut donc l'éviter, essaie simplement :
VB: 
Range("j6:j" & dl).WrapText = True
Code:
ou encore, si nécessaire :
VB: 
With Range("j6:j" & dl)
    .WrapText = False
    If Application.Count(.Cells) Then .SpecialCells(xlCellTypeConstants, 1).WrapText = True
End With
A+
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
job75 à dit:
Bonjour Lionel, le fil,

Ce qui prend du temps c'est cette boucle :
VB: 
   For Each c In Range("j6:j" & dl)
        If IsDate(c) Then
            'c.RowHeight = 30
            c.WrapText = True
        End If
    Next
Il faut donc l'éviter, essaie simplement :
VB: 
Range("j6:j" & dl).WrapText = True
Code:
ou encore, si nécessaire :
VB: 
With Range("j6:j" & dl)
    .WrapText = False
    If Application.Count(.Cells) Then .SpecialCells(xlCellTypeConstants, 1).WrapText = True
End With
A+
Cliquez pour agrandir...
Bonjour Gérard,
Merci d'être encore là pour moi :)
Je vais tester et je reviens,
lionel,
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Re-Gérard,
Voici le résultat :

VB: 
Sub tri_rappels()
T = Timer
    ActiveSheet.Unprotect Password:=""
    Application.ScreenUpdating = False: Application.EnableEvents = False
    With ActiveSheet 'CodeName
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Rows("6:" & .Range("k65536").End(xlUp).Row)
        If .Row < 6 Then Exit Sub 'sécurité
        .Sort .Columns(11), xlAscending, Header:=xlNo
    End With
    End With

MsgBox Timer - T :                                                                                3.24
Dim c As Range, dl As Long, Tablo, Tablo2, I&
    dl = Cells(Rows.Count, "J").End(xlUp).Row
    With Range("j6:j" & dl)
        .NumberFormat = "dd/mm/yyyy" & vbLf & "hh:mm"
        Tablo = .Value2
        Tablo2 = Tablo
        On Error Resume Next
        For I = LBound(Tablo, 1) To UBound(Tablo, 1)
            Tablo2(I, 1) = Tablo(I, 1)
            Tablo2(I, 1) = CDate(Replace(Application.Trim(Tablo(I, 1)), ".", "/"))
        Next I
        On Error GoTo 0
        .Value = Tablo2
    End With
MsgBox Timer - T                                                                                 18.04
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=Range("J6:J" & dl), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
        .SetRange Range("a6:z" & dl)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
MsgBox Timer - T                                                                                29.42
    For Each c In Range("j6:j" & dl)
        If IsDate(c) Then
            'c.RowHeight = 30
            c.WrapText = True
        End If
    Next
MsgBox Timer -T                                                                                 45.51
    'Range([a6], Cells(Rows.Count, "a").End(xlUp)).RowHeight = 55
    [c1].Select
    ActiveWindow.ScrollRow = Selection.Row
    'MsgBox ("Vous avez" & " " & [o5] & " " & "rappels aujourd'hui et/ou dépassés !")
    Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub
Pour 10000
lionel,
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
LOL désolé Gérard, re-voilou :
VB: 
Sub tri_rappels()
T = Timer
    ActiveSheet.Unprotect Password:=""
    Application.ScreenUpdating = False: Application.EnableEvents = False
    With ActiveSheet 'CodeName
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .Rows("6:" & .Range("k65536").End(xlUp).Row)
        If .Row < 6 Then Exit Sub 'sécurité
        .Sort .Columns(11), xlAscending, Header:=xlNo
    End With
    End With

[B]MsgBox Timer - T = 3.47[/B]
T = Timer
Dim c As Range, dl As Long, Tablo, Tablo2, I&
    dl = Cells(Rows.Count, "J").End(xlUp).Row
    With Range("j6:j" & dl)
        .NumberFormat = "dd/mm/yyyy" & vbLf & "hh:mm"
        Tablo = .Value2
        Tablo2 = Tablo
        On Error Resume Next
        For I = LBound(Tablo, 1) To UBound(Tablo, 1)
            Tablo2(I, 1) = Tablo(I, 1)
            Tablo2(I, 1) = CDate(Replace(Application.Trim(Tablo(I, 1)), ".", "/"))
        Next I
        On Error GoTo 0
        .Value = Tablo2
    End With
[B]MsgBox Timer - T = 7.06[/B]
T = Timer
    With ActiveSheet.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=Range("J6:J" & dl), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
        .SetRange Range("a6:z" & dl)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
[B]MsgBox Timer - T = 3.45[/B]
T = Timer
    For Each c In Range("j6:j" & dl)
        If IsDate(c) Then
            'c.RowHeight = 30
            c.WrapText = True
        End If
    Next
[B]MsgBox Timer - T = 8.11[/B]
    'Range([a6], Cells(Rows.Count, "a").End(xlUp)).RowHeight = 55
    [c1].Select
    ActiveWindow.ScrollRow = Selection.Row
    'MsgBox ("Vous avez" & " " & [o5] & " " & "rappels aujourd'hui et/ou dépassés !")
    Application.ScreenUpdating = True: Application.EnableEvents = True
End Sub
tjrs pour 10.000 lignes
:)
 
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
Re-Gérard,

J'ai tenté d'extraire de mon fichier la Feuille concernée pour faire un fichier test mais ça ne fonctionne pas, le temps d'exécution n'est pas du tout le même ... ça doit venir d'ailleurs.
J'essaierai de refaire un nouveau fichier ce WE.

Merci gérard :)
lionel,
 
Vote positif 0 Vote négatif
job75

job75

XLDnaute Barbatruc
Bon laisse tomber, j'ai revu ta macro :
Code: 
Sub tri_rappels()
Dim tablo, i&, dat$
    With ActiveSheet
        .Protect Password:="", UserInterfaceOnly:=True
        If .FilterMode Then .ShowAllData 'si la feuille est filtrée
        With .Range("j6", .Cells(.Rows.Count, "J").End(xlUp))
            If .Row < 6 Then Exit Sub 'sécurité
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            tablo = .Resize(, 2).Value2 'matrice, plus rapide, au moins 2 éléments
            For i = 1 To UBound(tablo)
                If Not IsNumeric(tablo(i, 1)) Then
                    dat = Replace(Application.Trim(tablo(i, 1)), ".", "/")
                    If IsDate(dat) Then tablo(i, 1) = CDate(dat)
                End If
            Next i
            .Value = tablo
            .EntireRow.Sort .Cells(1), xlAscending, Header:=xlNo 'tri croissant
            '---mise en forme, ces 2 lignes prennent du temps donc à supprimer---
            .EntireColumn.NumberFormat = "dd.mm.yy" & vbLf & "hh:mm"
            .EntireColumn.WrapText = True 'prend du temps, à enlever
            '-------------------------------------------------------
            .Cells(1).Select
        End With
    End With
    ActiveWindow.ScrollRow = Selection.Row
    Application.EnableEvents = True
End Sub
J'ai testé le fichier joint avec 10800 lignes.

Le traitement du tableau tablo est immédiat et le tri prend moins de 1/10ème de seconde.

Les 2 lignes de mise en forme prennent 4,4 secondes, ces 2 lignes de code sont donc à supprimer,

La colonne J entière sera mise en forme une seule fois, une fois pour toutes.
 

Pièces jointes

  • 10800 lignes(1).xlsm
    597.5 KB · Affichages: 4
Vote positif 0 Vote négatif
Usine à gaz

Usine à gaz

XLDnaute Barbatruc
job75 à dit:
Bon laisse tomber, j'ai revu ta macro :
Code: 
Sub tri_rappels()
Dim tablo, i&, dat$
    With ActiveSheet
        .Protect Password:="", UserInterfaceOnly:=True
        If .FilterMode Then .ShowAllData 'si la feuille est filtrée
        With .Range("j6", .Cells(.Rows.Count, "J").End(xlUp))
            If .Row < 6 Then Exit Sub 'sécurité
            Application.ScreenUpdating = False
            Application.EnableEvents = False
            tablo = .Resize(, 2).Value2 'matrice, plus rapide, au moins 2 éléments
            For i = 1 To UBound(tablo)
                If Not IsNumeric(tablo(i, 1)) Then
                    dat = Replace(Application.Trim(tablo(i, 1)), ".", "/")
                    If IsDate(dat) Then tablo(i, 1) = CDate(dat)
                End If
            Next i
            .Value = tablo
            .EntireRow.Sort .Cells(1), xlAscending, Header:=xlNo 'tri croissant
            '---mise en forme, ces 2 lignes prennent du temps donc à supprimer---
            .EntireColumn.NumberFormat = "dd.mm.yy" & vbLf & "hh:mm"
            .EntireColumn.WrapText = True 'prend du temps, à enlever
            '-------------------------------------------------------
            .Cells(1).Select
        End With
    End With
    ActiveWindow.ScrollRow = Selection.Row
    Application.EnableEvents = True
End Sub
J'ai testé le fichier joint avec 10800 lignes.

Le traitement du tableau tablo est immédiat et le tri prend moins de 1/10ème de seconde.

Les 2 lignes de mise en forme prennent 4,4 secondes, ces 2 lignes de code sont donc à supprimer,

La colonne J entière sera mise en forme une seule fois, une fois pour toutes.
Cliquez pour agrandir...
Super merci Gérard :)
je teste tout à l'heure et je reviens te dire ce que ça fait chez moi.
 
Vote positif 0 Vote négatif

Discussions similaires

S
  • Question
XL 2016 Afficher les bornes min et max dans lequel se trouve une valeur
Réponses
5
Affichages
392
stuka
S
R
  • Question
XL 2013 Problème formules
Réponses
6
Affichages
493
Rikko14
R
S
  • Résolu(e)
Microsoft 365 Vba, Mise en forme d'un calendrier
Réponses
8
Affichages
496
SOP
S
O
  • Question
XL 2019 Code VBA pour automatiser la programmation des rotations des ouvriers qui travaillent à temps partiel et se relaient par période de temps constante.
2 3
Réponses
35
Affichages
1 K
olivier1984
O
jeff1494
  • Question
XL 2021 Comment supprimer des noms du gestionnaire de noms dans un classeur
Réponses
7
Affichages
242
jeff1494
jeff1494
A
  • Question
XL 2021 Module d’envoi à la Corbeille qui ne fonctionne pas en 64 Bits
2
Réponses
20
Affichages
510
patricktoulon
patricktoulon
Usine à gaz
  • Question
XL 2021 formule pour modifier le CONTENU de certaines cellules
2
Réponses
23
Affichages
1 K
Usine à gaz
Usine à gaz
Usine à gaz
  • Question
XL 2021 code que je n'arrive pas à faite fonctionner avec Range("ActiveCell.Offset(0, 0).Resize(10, 1)")
2 3 4
Réponses
55
Affichages
2 K
Staple1600
Staple1600
M
  • Question
Microsoft 365 Macros bloquées (non actives) ???
2
Réponses
27
Affichages
2 K
Staple1600
Staple1600
S
  • Question
XL 2019 Modifier les "limitations/plages" d'une feuille
2
Réponses
15
Affichages
924
ST4423
S

Membres actuellement en ligne

19 membres et 185 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
315 103
Messages
2 116 233
Membres
112 695
dernier inscrit
ben44115