XL 2019 croiser 2 fichier via une macro

[escudo]

J'ai deux fichiers Excel : le premier répertorie les arrivées, et le second présente le rapport de création des cartes d'accès aux chambres. Je souhaite les croiser pour détecter d'éventuelles incohérences au niveau des dates et des chambres et générer une feuille d'anomalies en cas de divergences,
merci pour votre aide.

 

[job75]

Bonjour escudo,

Aucun nom client du 1er fichier(.xlsm) ne se retrouve dans le 2ème fichier (.xlsx) que devons nous faire ?

A+

 

[ChTi160]

Bonjour le Fil
Il pourrait y avoir des exemples de ce qui est attendu avec quelques explications ! dans une feuille de l'un des Fichier !
Cordialement
Jean marie

 

[job75]

J'ai commencé à restituer les anomalies avec une macro dans le fichier .xlsm, voyez cette copie d'écran.

 

[escudo]

J'ai commencé à restituer les anomalies avec une macro dans le fichier .xlsm, voyez cette copie d'écran.
Regarde la pièce jointe 1220273

 

[escudo]

Bonsoir les amis ,vous ne trouverez pas les mêmes noms dans les deux fichiers. Le premier fichier, qui est la liste des arrivées, contient les noms des clients, tandis que le deuxième fichier répertorie les noms des réceptionnistes ayant créé la carte magnétique des chambres. Le rapprochement s'effectue en croisant les numéros de chambre présents dans la liste des arrivées et dans le rapport de création des clés, en tenant compte des dates.

 

[job75]

Voyez le fichier joint et cette macro :

Option Compare Text 'la casse est ignorée

Sub Rapprochement()
Dim fichier As Variant, tablo, d As Object, i&, chambre$, dat$
fichier = Application.GetOpenFilename("Fichiers .xlsx (*.xlsx),*.xlsx")
If fichier = False Then Exit Sub
Application.ScreenUpdating = False
tablo = Workbooks.Open(fichier).Sheets(1).UsedRange.Columns(1) 'matrice, plus rapide
ActiveWorkbook.Close False
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(tablo)
    If Left(Trim(tablo(i, 1)), 7) = "Chambre" Then
        chambre = Trim(Replace(Replace(tablo(i, 1), "Chambre", ""), ":", ""))
        If IsDate(tablo(i - 1, 1)) Then 'date sur la ligne précédente
            dat = Format(tablo(i - 1, 1), "dd.mm.yy")
            d(dat & chambre) = ""
        End If
    End If
Next i
With ActiveSheet.UsedRange
    .Columns(14).ClearContents 'RAZ en colonne N
    tablo = .Resize(, 14) 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        chambre = tablo(i, 8)
        If chambre <> "" Then If Not d.exists(tablo(i, 1) & chambre) And Not d.exists(tablo(i, 2) & chambre) _
            Then tablo(i, 14) = "Pas trouvé" 'repère en colonne N
    Next i
    .Columns(14) = Application.Index(tablo, , 14) 'restitution
End With
End Sub

Edit : avec le Dictionary c'est plus rapide.

Je vous laisse vérifier que cela vous convient bien.

Bonne nuit.

 

[job75]

Bonjour escudo, le forum,

L'ouverture et la fermeture du fichier .xlsx par la macro prennent un peu de temps => 0,3 seconde sur l'exemple.

Il vaut mieux remplacer ce fichier par un fichier CSV que l'on ouvre en lecture séquentielle :

Option Compare Text 'la casse est ignorée

Sub Rapprochement()
Dim fichier As Variant, d As Object, x%, texte$, chambre$, dat$, tablo, i&
fichier = Application.GetOpenFilename("Fichiers CSV (*.csv),*.csn")
If fichier = False Then Exit Sub
Set d = CreateObject("Scripting.Dictionary")
x = FreeFile
Open fichier For Input As #x 'ouverture en lecture séquentielle
While Not EOF(x)
    Line Input #x, texte
    If Left(Trim(texte), 7) = "Chambre" Then
        chambre = Val(Replace(Replace(texte, "Chambre", ""), ":", ""))
        If IsDate(dat) Then 'date sur la ligne précédente
            dat = Format(dat, "dd.mm.yy")
            d(dat & chambre) = ""
        End If
    End If
    dat = Left(texte, 10) 'mémorise la ligne
Wend
Close #x
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
    .Columns(14).ClearContents 'RAZ en colonne N
    tablo = .Resize(, 14) 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        chambre = tablo(i, 8)
        If chambre <> "" Then If Not d.exists(tablo(i, 1) & chambre) And Not d.exists(tablo(i, 2) & chambre) _
            Then tablo(i, 14) = "Pas trouvé" 'repère en colonne N
    Next i
    .Columns(14) = Application.Index(tablo, , 14) 'restitution
End With
End Sub

L'exécution est immédiate.

A+

 

[escudo]

Bonjour escudo, le forum,

L'ouverture et la fermeture du fichier .xlsx par la macro prennent un peu de temps => 0,3 seconde sur l'exemple.

Il vaut mieux remplacer ce fichier par un fichier CSV que l'on ouvre en lecture séquentielle :

Option Compare Text 'la casse est ignorée

Sub Rapprochement()
Dim fichier As Variant, d As Object, x%, texte$, chambre$, dat$, tablo, i&
fichier = Application.GetOpenFilename("Fichiers CSV (*.csv),*.csn")
If fichier = False Then Exit Sub
Set d = CreateObject("Scripting.Dictionary")
x = FreeFile
Open fichier For Input As #x 'ouverture en lecture séquentielle
While Not EOF(x)
    Line Input #x, texte
    If Left(Trim(texte), 7) = "Chambre" Then
        chambre = Val(Replace(Replace(texte, "Chambre", ""), ":", ""))
        If IsDate(dat) Then 'date sur la ligne précédente
            dat = Format(dat, "dd.mm.yy")
            d(dat & chambre) = ""
        End If
    End If
    dat = Left(texte, 10) 'mémorise la ligne
Wend
Close #x
Application.ScreenUpdating = False
With ActiveSheet.UsedRange
    .Columns(14).ClearContents 'RAZ en colonne N
    tablo = .Resize(, 14) 'matrice, plus rapide
    For i = 2 To UBound(tablo)
        chambre = tablo(i, 8)
        If chambre <> "" Then If Not d.exists(tablo(i, 1) & chambre) And Not d.exists(tablo(i, 2) & chambre) _
            Then tablo(i, 14) = "Pas trouvé" 'repère en colonne N
    Next i
    .Columns(14) = Application.Index(tablo, , 14) 'restitution
End With
End Sub

L'exécution est immédiate.

A+

Merci, c’est exactement ce que je voulais