Tri de deux tableaux liés

[Nplayer76]

Bonjour,

j'espère que l'un de vous pourra m'éclairer, car là je sèche un peu.

Sur un onglet j'ai un tableau où sont rentrées des données.
Sur un 2ème onglet j'ai un second tableau, qui reprend certaines données du 1er, et qui est complété par des données rentrées manuellement.

Mon problème est que lorsque j'effectue un tri sur le 1er tableau, dans le 2e tableau seules les données liées au 1er sont triées, les données rentrées manuellement ne suivent pas, ce qui me casse le tableau.

Auriez-vous une solution (traditionnelle ou en VBA) pour que le tri s'effectue sur les 2 tableaux ?

Merci d'avance.

 

[job75]

Bojour Nplayer76, bienvenue sur XLD,

Félicitations, pour un 1er post c'est une question excellente.

Voyez le fichier joint et cette macro dans le code de la feuille "Copie" (clic droit sur l'onglet et Visualiser le code) :

Private Sub Worksheet_Calculate()
Dim colman%, t, d As Object, i&
colman = 6 'n° de colonne des entrées manuelles, à adapter
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
With [A1].CurrentRegion
  Application.Undo
  t = .Resize(, colman) 'tableau précédent
  Application.Undo
  Set d = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(t)
    d(t(i, 1)) = t(i, colman) 'mémorise
  Next
  t = .Resize(, colman) 'dernier tableau
  For i = 1 To UBound(t)
    t(i, colman) = d(t(i, 1))
  Next
  .Columns(colman) = Application.Index(t, , colman) 'restitution
End With
Application.EnableEvents = True 'réactive les évènements
End Sub

La macro s'exécute en particulier quand on effectue un tri.

Il faut impérativement une colonne avec des références uniques (la 1ère colonne ici).

A+

 

[job75]

Re,

Utilisant un tableau VBA et le Dictionary la macro est très rapide.

Pour tester j'ai tiré les 2 tableaux sur 20 000 lignes.

Chez moi sur Win 10 - Excel 2013 la macro s'exécute en 0,56 seconde.

A+

 

[Nplayer76]

Merci beaucoup pour la rapidité

Je viens de tester, ça marche super. En plus j'ai un 3e tableau qui est sur le meme modele et ca marche aussi tu me sauves, j'étais en train de renoncer à l'idée.

Je me permets d'abuser de ton savoir une dernière fois, car j'ai fait des essais mais je n'ai pas trouvé. Il y a plusieurs colonnes d'entrée manuelle. Je dois dupliquer la procédure pour chaque colonne, ou ya moyen d'intégrer plusieurs numéros de colonne à la procédure ?

 

[job75]

Re,

Il y a plusieurs colonnes d'entrée manuelle.

Le traitement sera un peu plus lourd car il faudra utiliser un Dictionary pour chaque colonne d'entrée manuelle.

La macro pour 3 colonnes d'entrée manuelle, numéros des colonnes à adapter bien sûr :

Private Sub Worksheet_Calculate()
Dim colman1%, colman2%, colman3%, sel As Range, t, d1 As Object, d2 As Object, d3 As Object, i&
colman1 = 6 'n° de colonne 1ère entrée manuelle, à adapter
colman2 = 7 'n° de colonne 2ème entrée manuelle, à adapter
colman3 = 8 'n° de colonne 3ème entrée manuelle, à adapter
Application.ScreenUpdating = False 'fige l'écran
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
Set sel = Selection 'mémorise
With [A1].CurrentRegion
  Application.Undo
  t = .Resize(, Application.Max(colman1, colman2, colman3)) 'tableau précédent
  Application.Undo
  Set d1 = CreateObject("Scripting.Dictionary")
  Set d2 = CreateObject("Scripting.Dictionary")
  Set d3 = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(t)
    d1(t(i, 1)) = t(i, colman1) 'mémorise
    d2(t(i, 1)) = t(i, colman2) 'mémorise
    d3(t(i, 1)) = t(i, colman3) 'mémorise
  Next
  t = .Resize(, Application.Max(colman1, colman2, colman3)) 'dernier tableau
  For i = 1 To UBound(t)
    t(i, colman1) = d1(t(i, 1))
    t(i, colman2) = d2(t(i, 1))
    t(i, colman3) = d3(t(i, 1))
  Next
  .Columns(colman1) = Application.Index(t, , colman1) 'restitution
  .Columns(colman2) = Application.Index(t, , colman2) 'restitution
  .Columns(colman3) = Application.Index(t, , colman3) 'restitution
End With
sel.Select
Application.EnableEvents = True 'réactive les évènements
Application.ScreenUpdating = True 'rafraîchit l'écran
End Sub

Edit : j'ai ajouté les Application.ScreenUpdating, on gagne un peu de temps.

Sur 20 000 lignes (tableau de 8 colonnes en feuille "Copie") la durée d'exécution est de 1,08 seconde.

A+

 

[chris]

Bonjour

A noter que le demandeur a posté sur plusieurs forum

Rien ne l'interdit mais il est mieux de le préciser...

 

[job75]

Bonsoir chris, heureux de te croiser,

C'est la 1ère fois que Nplayer76 vient chez nous, j'essaie de l'accueillir convenablement.

Il n'a peut-être pas trouvé chaussure à son pied ailleurs.

Bonne fin de soirée.

 

[job75]

Bonjour Nplayer76, chris, le forum,

J'ai ajouté les Application.ScreenUpdating dans la macro du post #5.

Si les colonnes d'entrée manuelle sont jointives on peut n'utiliser qu'un seul Dictionary et la commande Convertir :

Private Sub Worksheet_Calculate()
Dim colman1%, colman2%, colman3%, sel As Range, t, d As Object, i&
colman1 = 6 'n° de colonne 1ère entrée manuelle, à adapter
colman2 = colman1 + 1
colman3 = colman2 + 1
Application.ScreenUpdating = False 'fige l'écran
Application.DisplayAlerts = False 'pour la commande Convertir
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
Set sel = Selection 'mémorise
With [A1].CurrentRegion
  Application.Undo
  t = .Resize(, colman3) 'tableau précédent
  Application.Undo
  Set d = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(t)
    d(t(i, 1)) = t(i, colman1) & Chr(1) & t(i, colman2) & Chr(1) & t(i, colman3)  'mémorise
  Next
  t = .Resize(, colman3) 'dernier tableau
  For i = 1 To UBound(t)
    t(i, colman1) = d(t(i, 1))
  Next
  .Columns(colman1) = Application.Index(t, , colman1) 'restitution
  .Columns(colman1).TextToColumns .Columns(colman1), xlDelimited, , Other:=True, OtherChar:=Chr(1) 'commande Convertir
End With
sel.Select
Application.EnableEvents = True 'réactive les évènements
Application.ScreenUpdating = True 'rafraîchit l'écran
End Sub

C'est un peu plus rapide, sur 20 000 lignes => 0,91 seconde.

Fichier (2).

Bonne journée.

 

[Nplayer76]

Merci, je vais essayer ça, sachant que j'ai 40 colonnes de saisie manuelle, et effectivement elles sont jointives donc je vais utiliser ta dernière macro. Le tri étant occasionnel ce n'est pas grave si le traitement est un peu long.

Oui j'avais posté sur un autre forum (développez.com) mais je n'ai pas trouvé de réponse convenable. Je ne pensais pas que c'était mal vu....

 

[chris]

Bonjour

...
Oui j'avais posté sur un autre forum (développez.com) mais je n'ai pas trouvé de réponse convenable. Je ne pensais pas que c'était mal vu....

Mal vu non, mais il est mieux de le signaler afin que les xldiens puissent voir les autres pistes proposées et ne pas chercher dans la même direction mais plutôt des alternatives.

 

[job75]

Re,

sachant que j'ai 40 colonnes de saisie manuelle, et effectivement elles sont jointives

J'ai constaté qu'avec 40 colonnes concaténées Application.Index(t,,colman1) ne veut pas fonctionner !?

Mais on s'en sort avec un tableau auxiliaire a, voici la macro :

Private Sub Worksheet_Calculate()
Dim colman1%, ncolman%, colmax%, sel As Range, t, d As Object, i&, x$, j%, a()
colman1 = 6 'n° de la 1ère colonne d'entrée manuelle, à adapter
ncolman = 40 'nombre de colonnes d'entrée manuelle jointives, à adapter
colmax = colman1 + ncolman - 1 'n° de la dernière colonne d'entrée manuelle
Application.ScreenUpdating = False 'fige l'écran
Application.DisplayAlerts = False 'pour la commande Convertir
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
Set sel = Selection 'mémorise
With [A1].CurrentRegion
  Application.Undo
  t = .Resize(, colmax) 'tableau précédent
  Application.Undo
  Set d = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(t)
    x = "" 'RAZ
    For j = colman1 To colmax
      x = x & Chr(1) & t(i, j)
    Next
    d(t(i, 1)) = Mid(x, 2) 'mémorise la concaténation
  Next
  t = .Resize(, colmax) 'dernier tableau
  ReDim a(1 To UBound(t), 1 To 1) 'car Application.Index(t,,colman1) ne veut pas fonctionner !!!
  For i = 1 To UBound(t)
    a(i, 1) = d(t(i, 1))
  Next
  .Columns(colman1) = a 'restitution
  .Columns(colman1).TextToColumns .Columns(colman1), xlDelimited, , Other:=True, OtherChar:=Chr(1) 'commande Convertir
End With
sel.Select
Application.EnableEvents = True 'réactive les évènements
Application.ScreenUpdating = True 'rafraîchit l'écran
End Sub

Fichier (3).

Testé sur 20 000 lignes (fichier de 7 Mo), la durée d'exécution est de 7,1 secondes.

A+

 

[Nplayer76]

Justement j'étais en train de t'écrire un post, car je n'arrivais pas à l'adapter à 44 colonnes.

Je viens de tester ca marche très bien Cependant j'ai un bug au niveau des en-têtes. En mode tableau ça me change carrément la dénomination des en-têtes, en compilant toutes les données d'en-têtes manuelles, et en mode plage ca me change juste la hauteur des colonnes.

Je te joins un modèle du tableau pour que tu visualises ce que je dis.

 

[job75]

Re,

Oui bien sûr, si l'on utilise un tableau Excel il ne faut pas traiter la ligne des en-têtes.

Pour les hauteurs des lignes il suffit de les ajuster automatiquement.

Par ailleurs si le tableau contient des dates il faut utiliser la propriété .Value2.

Enfin il est moins problématique et aussi rapide d'utiliser le tableau a à la place de la commande Convertir.

La macro modifiée :

Private Sub Worksheet_Calculate()
Dim colman1%, ncolman%, colmax%, sel As Range, t, d As Object, i&, x$, j%, a(), s
colman1 = 11 'n° de la 1ère colonne d'entrée manuelle, à adapter
ncolman = 44 'nombre de colonnes d'entrée manuelle jointives, à adapter
colmax = colman1 + ncolman - 1 'n° de la dernière colonne d'entrée manuelle
Application.ScreenUpdating = False 'fige l'écran
Application.EnableEvents = False 'désactive les évènements
On Error Resume Next
Set sel = Selection 'mémorise
With [A1].CurrentRegion.Offset(1).Resize([A1].CurrentRegion.Rows.Count - 1) 'évite la ligne d'en-têtes
  Application.Undo
  t = .Resize(, colmax).Value2 'tableau précédent, .Value2 important pour les dates/heures
  Application.Undo
  Set d = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(t)
    x = "" 'RAZ
    For j = colman1 To colmax
      x = x & Chr(1) & t(i, j)
    Next
    d(t(i, 1)) = Mid(x, 2) 'mémorise la concaténation
  Next
  t = .Resize(, colmax).Value2 'dernier tableau, .Value2 important pour les dates/heures
  ReDim a(1 To UBound(t), 1 To ncolman)
  For i = 1 To UBound(t)
    s = Split(d(t(i, 1)), Chr(1))
    For j = 1 To ncolman
      a(i, j) = s(j - 1)
      If IsNumeric(a(i, j)) Then a(i, j) = CDbl(a(i, j))
  Next j, i
  .Columns(colman1).Resize(, ncolman) = a 'restitution
  .Rows.AutoFit 'ajustement hauteurs des lignes
End With
sel.Select
Application.EnableEvents = True 'réactive les évènements
Application.ScreenUpdating = True 'rafraîchit l'écran
End Sub

Testé sur 20 000 lignes (fichier de 8 Mo) => 5,3 secondes.

A+

 

[Nplayer76]

Je viens de tester ta dernière macro sur le tableau, ca marche parfaitement ! Encore merci pour ta patience et ton expertise (je t'avoue que je n'ai pas compris toutes les lignes). Maintenant je resterai sur ce forum

 

[job75]

Bonjour Nplayer76, le forum,

En testant le fichier précédent je découvre un phénomène très curieux et intéressant.

Si après exécution d'un tri en feuille "Base" on essaie d'entrer/modifier une donnée manuelle en feuille "Copie", l'opération est annulée.

C'est dû au fait que la macro Worksheet_Calculate se relance, et pourtant il n'y a pas de formule volatile !??

Il faut répéter l'entrée/modification pour qu'elle aboutisse.

Je n'ai pas d'explication à ce phénomène qui se produit aussi bien en mode Plage qu'en mode Tableau.

Edit : il semble que le phénomène soit dû aux Application.EnableEvents, je les remplace donc par la variable flag :

Private Sub Worksheet_Calculate()
Static flag As Boolean 'mémorise la variable
If flag Then Exit Sub
Dim colman1%, ncolman%, colmax%, sel As Range, t, d As Object, i&, x$, j%, a(), s
colman1 = 11 'n° de la 1ère colonne d'entrée manuelle, à adapter
ncolman = 44 'nombre de colonnes d'entrée manuelle jointives, à adapter
colmax = colman1 + ncolman - 1 'n° de la dernière colonne d'entrée manuelle
Application.ScreenUpdating = False
On Error GoTo 1
flag = True 'bloque le recalcul
If Me.FilterMode Then Me.ShowAllData 'si la feuille est filtrée
With [A1].CurrentRegion.Offset(1).Resize([A1].CurrentRegion.Rows.Count - 1) 'évite la ligne d'en-têtes
  Set sel = Selection 'mémorise
  Application.Undo
  t = .Resize(, colmax).Value2 'tableau précédent, .Value2 important pour les dates/heures
  Application.Undo
  sel.Select
  Set d = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(t)
    x = "" 'RAZ
    For j = colman1 To colmax
      x = x & Chr(1) & t(i, j)
    Next
    d(t(i, 1)) = Mid(x, 2) 'mémorise la concaténation
  Next
  t = .Columns(1).Value2 'colonne de référence du dernier tableau
  ReDim a(1 To UBound(t), 1 To ncolman)
  For i = 1 To UBound(t)
    s = Split(d(t(i, 1)), Chr(1))
    For j = 1 To ncolman
      a(i, j) = s(j - 1)
      If IsNumeric(a(i, j)) Then a(i, j) = CDbl(a(i, j))
  Next j, i
  .Columns(colman1).Resize(, ncolman) = a 'restitution
  .Rows.AutoFit 'ajustement hauteurs des lignes
End With
1 flag = False 'RAZ
Application.ScreenUpdating = True
End Sub

Nota : j'ai ajouté If Me.FilterMode Then Me.ShowAllData

Fichier (2).

A+