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

R
  • Question
XL 2013 Problème formules
Réponses
6
Affichages
469
Rikko14
R
S
  • Résolu(e)
Microsoft 365 Vba, Mise en forme d'un calendrier
Réponses
8
Affichages
410
SOP
S
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
856
ST4423
S
V
  • Question
XL 2021 Implémenter tableau avec des fichiers mis dans un dossier
Réponses
2
Affichages
304
merinos
merinos
Usine à gaz
  • Résolu(e)
Microsoft 365 Vérification de ma formule
2
Réponses
16
Affichages
2 K
Usine à gaz
Usine à gaz
Y
  • Question
Autres Tri de données
Réponses
10
Affichages
780
JHA
J
N
  • Question
Microsoft 365 [Résolu] Couleurs doublons multiple
Réponses
8
Affichages
732
Neo37
N

Membres actuellement en ligne

Aucun membre en ligne actuellement.
1 membres et 72 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
314 628
Messages
2 111 337
Membres
111 104
dernier inscrit
JEMADA