Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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

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
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) :

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

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)

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

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

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

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

XLDnaute Barbatruc
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

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

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

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

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

XLDnaute Barbatruc
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
Identifiez-vous ou inscrivez-vous pour participer.

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
  • Question
XL 2021 Comment supprimer des noms du gestionnaire de noms dans un classeur
Réponses
7
Affichages
245
jeff1494
A
  • Question
XL 2021 Module d’envoi à la Corbeille qui ne fonctionne pas en 64 Bits
2
Réponses
20
Affichages
510
patricktoulon
  • Question
XL 2021 formule pour modifier le CONTENU de certaines cellules
2
Réponses
23
Affichages
1 K
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
M
  • Question
Microsoft 365 Macros bloquées (non actives) ???
2
Réponses
27
Affichages
2 K
Staple1600
S
  • Question
XL 2019 Modifier les "limitations/plages" d'une feuille
2
Réponses
15
Affichages
924
ST4423
S
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…