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

Usine à gaz

Usine à gaz

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

Usine à gaz
  • Question
XL 2021 formule pour modifier le CONTENU de certaines cellules
2
Réponses
23
Affichages
910
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
1 K
Staple1600
Staple1600
M
  • Question
Microsoft 365 Macros bloquées (non actives) ???
2
Réponses
27
Affichages
1 K
Staple1600
Staple1600
S
  • Question
XL 2019 Modifier les "limitations/plages" d'une feuille
2
Réponses
15
Affichages
552
ST4423
S
V
  • Question
XL 2021 Implémenter tableau avec des fichiers mis dans un dossier
Réponses
2
Affichages
185
merinos
merinos
Usine à gaz
  • Résolu(e)
Microsoft 365 Vérification de ma formule
2
Réponses
16
Affichages
1 K
Usine à gaz
Usine à gaz
Y
  • Question
Autres Tri de données
Réponses
10
Affichages
617
JHA
J
N
  • Question
Microsoft 365 [Résolu] Couleurs doublons multiple
Réponses
8
Affichages
580
Neo37
N
B
  • Question
Microsoft 365 Automatisation fichier de compte rendu
Réponses
13
Affichages
788
Blf57
B
A
  • Résolu(e)
Microsoft 365 Excel 365 x Power Query : suivi campagnes promotionnelles
Réponses
4
Affichages
679
Atsuki
A

Membres actuellement en ligne

Aucun membre en ligne actuellement.
0 membres et 38 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
312 294
Messages
2 086 895
Membres
103 404
dernier inscrit
sultan87