Trier numéro en fonction de journée
Salut tout le monde !
Je viens sur ce forum parce que je suis en galère et je n'ai pas les connaissances nécessaires pour faire ça.
Voilà j'ai 2 fichiers (ou 2 feuilles c'est pareil), avec des numéros de trains (un fichier par période différente) et des jours de circulations.
J'aimerais pouvoir comparer les 2 fichiers pour connaître les modifications entre les 2. En gros je voudrais savoir si les trains de la période A circulent en période B et inversement. Le soucis c'est qu'il faut aussi voir en fonction du jour de circulation : par exemple le 716000 circule le lundi en période A et circule les lundi et dimanche en période B.
Pour le moment je dois tout faire à la main et ...c'est long et j'ai peur de me tromper entre les colonnes et les lignes. Donc si j'ai un moyen de filtrer ceux que je dois modifier ce serait parfait !
J'ai joint un fichier avec 2 feuilles pour imager. Si quelqu'un avait une solution ça m'aiderait beaucoup !
Merci !
Bonjour
2 solutions au choix :
- PowerQuery (intégré à Excel)
Choisir une numéro de voyage dans le liste puis Données, Actualiser tout - Formules 365
Bonjour à tous !
Une autre approche Power Query (et une restitution différente) ?
Sur la base du classeur de 78chris (Hello !) :
Merci à tous pour vos réponses,
je n'arrive pas à changer les numéros dans vos fichiers
Dans les 3 celle qui me parait être la plus simple est celle de JFL, on voit directement quel jour le train ne circule pas en comparant les 2 tableaux.
Le soucis c'est que je vais devoir faire ça régulièrement, y a t-il un moyen simple de mettre en oeuvre vos solutions ? Je voudrais présenter ça aux collègues mais ils sont encore plus pommés que moi sur Excel et en informatique en général lol
On doit faire ça régulièrement et le fichier qui compile les infos nous sort un fichier avec 23 colonnes. Seule les colonnes K (numéro de train) et C (jour de la semaine, écrit en lettre) sont à prendre en compte dans ma demande.
Je pensais à quelque chose genre mise en forme conditionnel pour que ça saute aux yeux, mais j'en suis incapable
Merci beaucoup en tout cas, pour tout !
Bonjour à tous !
Comme le précisait 78chris, quand la source évolue (numéro train), il faut "Actualiser" pour rafraîchir le/les tableau(x).
Pour "Actualiser" : clic droit sur une cellule du tableau puis choisir "Actualiser" :
Bonjour
Bonjour à tous
..., y a t-il un moyen simple de mettre en oeuvre vos solutions ?
Pour ce qui me concerne :
Bye !
Bonjour à tous,
Juste pour le fun, en amont, tu peux regrouper tes données à traiter dans une seule feuille avec ce bout de code, le traitement en sera facilité.
Option Explicit
Sub copy()
Dim x, Entetes, e, s, n As Byte
Entetes = Array("Type Jr", "voyage")
n = 1
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Feuil1").Delete
On Error GoTo 0
Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Feuil1"
For Each s In Array("01", "02")
With Sheets(s)
x = Application.Match(Entetes, .Rows(1), 0)
For Each e In x
If IsNumeric(e) Then
.Columns(e).copy Sheets("Feuil1").Columns(n)
n = n + 1
End If
Next
End With
Next
End SubEdit : avec le fichier du post #1
klin89
Re à tous,
En VBA, on peut aussi ressortir le résultat sous cette forme en alignant les données :
Pour te faciliter la tâche, en Feuil1, j'ai rassemblé les données à traiter issues des 4 colonnes figurant dans les 2 feuilles sources via la macro proposée ci-dessus, puis exécuter la macro ci-dessous.
Option Explicit
Sub test()
Dim a, e, i As Long, ii As Byte, t As Byte, n As Long
Dim dico As Object, txt As String
Set dico = CreateObject("Scripting.dictionary")
dico.CompareMode = 1
a = Sheets("Feuil1").Cells(1).CurrentRegion.Value
For ii = 2 To UBound(a, 2) Step 2
For i = 2 To UBound(a, 1)
txt = Join(Array(a(i, ii), a(i, ii - 1)), Chr(2))
If Not dico.exists(txt) Then
ReDim w(1 To 4)
Else
w = dico(txt)
End If
If ii = 2 Then
t = UBound(w) - 2
Else
t = UBound(w)
End If
w(t) = a(i, ii): w(t - 1) = a(i, ii - 1)
dico(txt) = w
Next
Next
Application.ScreenUpdating = False
With Sheets.Add.Cells(1).Resize(, UBound(a, 2))
.Value = Array("Période A", "Trains", "Période B", "Trains")
n = 2
For Each e In dico
.Rows(n).Resize(, UBound(dico(e))).Value = dico(e)
n = n + 1
Next
With .CurrentRegion
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.Font.Size = 10
.Font.Name = "calibri"
With .Rows(1)
.BorderAround Weight:=xlThin
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = 40
.Font.Size = 11
End With
End With
End With
Set dico = Nothing
Application.ScreenUpdating = True
End Subklin89
Re bonsoir
Une version améliorée où l'on peut visualiser tous les jours de la semaine, disposition différente de gmb mais résultat identique.
Option Explicit
Sub test()
Dim a, e, x, w, joursSem, pos As Byte, i As Long, ii As Byte, t As Byte, n As Long
Dim dico As Object
Set dico = CreateObject("Scripting.dictionary")
dico.CompareMode = 1
a = Sheets("Feuil1").Cells(1).CurrentRegion.Value
ReDim x(1 To 7, 1 To 4)
joursSem = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
For ii = 1 To 7
x(ii, 1) = joursSem(ii - 1)
x(ii, 3) = joursSem(ii - 1)
Next
For ii = 2 To UBound(a, 2) Step 2
For i = 2 To UBound(a, 1)
If a(i, ii) <> "" Then
If Not dico.exists(a(i, ii)) Then
w = x
Else
w = dico(a(i, ii))
End If
If ii = 2 Then
t = UBound(w, 2) - 2
Else
t = UBound(w, 2)
End If
pos = Application.Match(a(i, ii - 1), Application.Index(w, 0, ii - 1), 0)
w(pos, t) = a(i, ii)
dico(a(i, ii)) = w
End If
Next
Next
Application.ScreenUpdating = False
With Sheets.Add.Cells(1).Resize(, UBound(a, 2))
.Value = Array("Période A", "Trains", "Période B", "Trains")
n = 2
For Each e In dico
With .Rows(n).Resize(UBound(dico(e), 1), UBound(dico(e), 2))
.Value = dico(e)
.BorderAround Weight:=xlThin
End With
n = n + UBound(dico(e), 1)
Next
With .CurrentRegion
.BorderAround Weight:=xlThin
'.Borders(xlInsideVertical).Weight = xlThin
.Font.Size = 10
.Font.Name = "calibri"
With .Rows(1)
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = 40
.Font.Size = 11
End With
End With
End With
Set dico = Nothing
Application.ScreenUpdating = True
End Subklin89
Merci beaucoup !! @Klin89 je pense que l'affichage est super, on voit rapidement quel train je dois ajouter/supprimer. Seul bémol, je ne comprends pas pourquoi je n'ai pas le même affichage ..
en gros j'ouvre mon fichier que j'ai transmis sur le premier post, je fais F11, cliques droit ajouter un module et je colle là ?
J'enregistre en .xlsm je lance la macro et ça m'affiche ça :
normal ? J'ai loupé un truc ?
En tout cas merci vous êtes au top !!
Re,
Oui c'est la 1ère macro qui rassemble les données sur la Feuil1 créé pour la circonstance.
Maintenant exécute la dernière macro que je t'ai envoyée hier soir.
klin89
ok merci je vais voir ça !!
Sans abusé de votre gentillesse...est-ce que vous pensez que ta macro peut fonctionner sur ce fichier @Klin89 ?
Aussi, je galère à tout faire fonctionner.. Il y a plusieurs codes et je ne sais pas si je dois exécuter chaque code (donc un module par code que tu m'as donné) ou si je dois tout mettre en un seul module ?
Aussi pour les futures modifications je peux juste reprendre ce fichier et copier coller au dessus (je suppose que oui) et ça devrait fonctionner ?
Merci pour vot' patience m'sieur dame, coder c'est pas pour moi
edit : et je vais un peu abuser ...mais y a t-il moyen de rajouter une couleur verte pâle sur les lignes qui n'ont aucun changement et en rouge pale pour les lignes qui sont différentes ? Comme dans ton screen de la version améliorée (j'aime beaucoup le tri par semaine ! C'est exactement ce qu'il me fallait !!)
Re,
Si tu changes le nom des feuilles dans ton nouveau classeur, regarde ici où s'opère le changement de noms.
Option Explicit
Sub copy()
Dim x, Entetes, e, s, n As Byte
Entetes = Array("Type Jr", "voyage")
n = 1
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Blabla").Delete '<-----
On Error GoTo 0
Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Blabla" '<-----
For Each s In Array("Feuil1", "Feuil2") '<-----
With Sheets(s)
x = Application.Match(Entetes, .Rows(1), 0)
For Each e In x
If IsNumeric(e) Then
.Columns(e).copy Sheets("Blabla").Columns(n) '<-----
n = n + 1
End If
Next
End With
Next
End SubSi on est certain que ce sont les 2 premières feuilles du classeur sur lesquelles s'appuie le traitement de la 1ère macro, on peut écrire ceci :
For Each s In Array(1, 2)2ème modification :
'Dans la 2ème macro, remplace cette ligne
a = Sheets("Feuil1").Cells(1).CurrentRegion.Value
par celle ci
a = Sheets("Blabla").Cells(1).CurrentRegion.ValueSinon, les 2 macros, tu peux les mettre dans le même module.
Pour les couleurs, passe par une MFC, ce sera plus simple, moi je suis nul en formule, je passe mon tour sur ce coup-là, après si quelqu'un peut retranscrire la MFC par VBA dans le tableau final, je suis preneur
klin89
Merci @ Klin89 mais je suis complètement perdu. J'essaie de l'appliquer à mon fichier réel, j'ai une erreur sur la macro là :
Option Explicit
Sub test()
Dim a, e, x, w, joursSem, pos As Byte, i As Long, ii As Byte, t As Byte, n As Long
Dim dico As Object
Set dico = CreateObject("Scripting.dictionary")
dico.CompareMode = 1
a = Sheets("Feuil1").Cells(1).CurrentRegion.Value
ReDim x(1 To 7, 1 To 4)
joursSem = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
For ii = 1 To 7
x(ii, 1) = joursSem(ii - 1)
x(ii, 3) = joursSem(ii - 1)
Next
For ii = 2 To UBound(a, 2) Step 2
For i = 2 To UBound(a, 1)
If a(i, ii) <> "" Then
If Not dico.exists(a(i, ii)) Then
w = x
Else
w = dico(a(i, ii))
End If
If ii = 2 Then
t = UBound(w, 2) - 2
Else
t = UBound(w, 2)
End If
pos = Application.Match(a(i, ii - 1), Application.Index(w, 0, ii - 1), 0)
w(pos, t) = a(i, ii)
dico(a(i, ii)) = w
End If
Next
Next
Application.ScreenUpdating = False
With Sheets.Add.Cells(1).Resize(, UBound(a, 2))
.Value = Array("Période A", "Trains", "Période B", "Trains")
n = 2
For Each e In dico
With .Rows(n).Resize(UBound(dico(e), 1), UBound(dico(e), 2))
.Value = dico(e)
.BorderAround Weight:=xlThin
End With
n = n + UBound(dico(e), 1)
Next
With .CurrentRegion
.BorderAround Weight:=xlThin
'.Borders(xlInsideVertical).Weight = xlThin
.Font.Size = 10
.Font.Name = "calibri"
With .Rows(1)
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = 40
.Font.Size = 11
End With
End With
End With
Set dico = Nothing
Application.ScreenUpdating = True
End Subil me dit ça
(j'utilise le fichier joint)
Si j'ai bien tout suivi, en gros je devrais faire un module avec ces 2 codes pour avoir ton affichage de tri par semaine ?
Option Explicit
Sub copy()
Dim x, Entetes, e, s, n As Byte
Entetes = Array("Type Jr", "voyage")
n = 1
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Feuil1").Delete
On Error GoTo 0
Sheets.Add(after:=Sheets(Sheets.Count)).Name = "Feuil1"
For Each s In Array("01", "02")
With Sheets(s)
x = Application.Match(Entetes, .Rows(1), 0)
For Each e In x
If IsNumeric(e) Then
.Columns(e).copy Sheets("Feuil1").Columns(n)
n = n + 1
End If
Next
End With
Next
End Sub
Option Explicit
Sub test()
Dim a, e, x, w, joursSem, pos As Byte, i As Long, ii As Byte, t As Byte, n As Long
Dim dico As Object
Set dico = CreateObject("Scripting.dictionary")
dico.CompareMode = 1
a = Sheets("Feuil1").Cells(1).CurrentRegion.Value
ReDim x(1 To 7, 1 To 4)
joursSem = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
For ii = 1 To 7
x(ii, 1) = joursSem(ii - 1)
x(ii, 3) = joursSem(ii - 1)
Next
For ii = 2 To UBound(a, 2) Step 2
For i = 2 To UBound(a, 1)
If a(i, ii) <> "" Then
If Not dico.exists(a(i, ii)) Then
w = x
Else
w = dico(a(i, ii))
End If
If ii = 2 Then
t = UBound(w, 2) - 2
Else
t = UBound(w, 2)
End If
pos = Application.Match(a(i, ii - 1), Application.Index(w, 0, ii - 1), 0)
w(pos, t) = a(i, ii)
dico(a(i, ii)) = w
End If
Next
Next
Application.ScreenUpdating = False
With Sheets.Add.Cells(1).Resize(, UBound(a, 2))
.Value = Array("Période A", "Trains", "Période B", "Trains")
n = 2
For Each e In dico
With .Rows(n).Resize(UBound(dico(e), 1), UBound(dico(e), 2))
.Value = dico(e)
.BorderAround Weight:=xlThin
End With
n = n + UBound(dico(e), 1)
Next
With .CurrentRegion
.BorderAround Weight:=xlThin
'.Borders(xlInsideVertical).Weight = xlThin
.Font.Size = 10
.Font.Name = "calibri"
With .Rows(1)
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = 40
.Font.Size = 11
End With
End With
End With
Set dico = Nothing
Application.ScreenUpdating = True
End SubLe premier code triera les données et l'autre mets en page ?
Je n'arrive pas à avoir ton résultat ...Vraiment désolé de t'embêter mais c'est pas facile de vous suivre
Re,
Relis mon post précédent, fais attention au noms des feuilles de calcul.
Purée, tu vas supprimer une feuille source 😫, la "Feuil1"
En plus, il y a un "Option Explicit" qui se balade au milieu et qui n'a pas lieu d'être lors de ton copié - collé dans le module.
klin89
Re moi,
J'ai mis cette formule en E2 pour faire ressortir les changements entre la colonne B et D, corrigez-moi vu que je ne suis pas très doué en formules.
'=SI(ET(ET($B2<>"";$D2<>"");$B2=$D2);"Pas de changement";SI(ET($B2="";$D2="");"";"Changement"))
Après je ne sais pas l'adapter dans une mise en forme conditionnelle
klin89
re n3o_c59
J'ai rajouté une mise en forme conditionnelle via ce bloc :
With .Offset(1).Resize(.Rows.Count - 1)
.FormatConditions.Delete
.FormatConditions.Add 2, Formula1:="=et($b2<>"""";$d2<>"""")"
.FormatConditions(1).Interior.ColorIndex = 15
.FormatConditions.Add 2, Formula1:="=$b2<>$d2"
.FormatConditions(2).Interior.ColorIndex = 36
End WithLe code revu et corrigé :
Sub test()
Dim a, e, x, w, joursSem, pos As Byte, i As Long, ii As Byte, t As Byte, n As Long
Dim dico As Object
Set dico = CreateObject("Scripting.dictionary")
dico.CompareMode = 1
a = Sheets("Blabla").Cells(1).CurrentRegion.Value
ReDim x(1 To 7, 1 To 4)
joursSem = Array("Lundi", "Mardi", "Mercredi", "Jeudi", "Vendredi", "Samedi", "Dimanche")
For ii = 1 To 7
x(ii, 1) = joursSem(ii - 1)
x(ii, 3) = joursSem(ii - 1)
Next
For ii = 2 To UBound(a, 2) Step 2
For i = 2 To UBound(a, 1)
If a(i, ii) <> "" Then
If Not dico.exists(a(i, ii)) Then
w = x
Else
w = dico(a(i, ii))
End If
If ii = 2 Then
t = UBound(w, 2) - 2
Else
t = UBound(w, 2)
End If
pos = Application.Match(a(i, ii - 1), Application.Index(w, 0, ii - 1), 0)
w(pos, t) = a(i, ii)
dico(a(i, ii)) = w
End If
Next
Next
Application.ScreenUpdating = False
With Sheets.Add.Cells(1).Resize(, UBound(a, 2))
.Value = Array("Période A", "Trains", "Période B", "Trains")
n = 2
For Each e In dico
With .Rows(n).Resize(UBound(dico(e), 1), UBound(dico(e), 2))
.Value = dico(e)
.BorderAround Weight:=xlThin
End With
n = n + UBound(dico(e), 1)
Next
With .CurrentRegion
.BorderAround Weight:=xlThin
'.Borders(xlInsideVertical).Weight = xlThin
.Font.Size = 10
.Font.Name = "calibri"
With .Rows(1)
.BorderAround Weight:=xlThin
.Borders(xlInsideVertical).Weight = xlThin
.HorizontalAlignment = xlCenter
.Interior.ColorIndex = 40
.Font.Size = 11
End With
With .Offset(1).Resize(.Rows.Count - 1)
.FormatConditions.Delete
.FormatConditions.Add 2, Formula1:="=et($b2<>"""";$d2<>"""")"
.FormatConditions(1).Interior.ColorIndex = 15
.FormatConditions.Add 2, Formula1:="=$b2<>$d2"
.FormatConditions(2).Interior.ColorIndex = 36
End With
End With
End With
Set dico = Nothing
Application.ScreenUpdating = True
End Subklin89