Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

XL 2019 croiser 2 fichier via une macro

Créer une discussion

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
E

escudo

XLDnaute Junior
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.
 

Pièces jointes

Solution
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 :
VB: 
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 =...
Trier par date Trier par votes
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.
 
Vote positif 0 Vote négatif
Voyez le fichier joint et cette macro :
VB: 
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.
 

Pièces jointes

Dernière édition:
Vote positif 0 Vote négatif
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 :
VB: 
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+
 

Pièces jointes

Vote positif 0 Vote négatif
Solution
Merci, c’est exactement ce que je voulais
 
Vote positif 0 Vote négatif
Identifiez-vous ou inscrivez-vous pour participer.
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

M
  • Question Question
XL 2016 Récupérer la planification d'un excel et la croiser avec un planning d'un autre Excel
Réponses
5
Affichages
973
vgendron
O
  • Question Question
XL 2019 Installation d'alertes avec conditions via une macro
Réponses
1
Affichages
819
Olocsob
O
D
  • Question Question
XL 2010 Création et mise à jour d'un TCD tableau croisé dynamique avec macro VBA
Réponses
1
Affichages
3 K
chris
M
  • Question Question
XL 2016 Transfère de données vers un autre fichier en VBA
Réponses
2
Affichages
2 K
mmaatthh
M
Z
  • Résolu(e)
Microsoft 365 Notifications excel dans une feuille récapitulative
2
Réponses
18
Affichages
2 K
Zifox
Z
  • Question Question
XL 2013 Formule Si? Macros? Amélioration de fichier Excel
Réponses
2
Affichages
1 K
aleadoju
M
  • Résolu(e)
XL 2019 Copier et renommer une feuille masquée (avec génération de code)
Réponses
5
Affichages
1 K
mautrait
M
I
  • Question Question
Microsoft 365 Récupérer valeurs dans une cellule de plusieurs fichiers Excel situés dans dossier partagé d'entreprise
2
Réponses
23
Affichages
9 K
IlyesT36
I
S
  • Question Question
XL 2016 Récupérer une formule dans une autre cellule
Réponses
6
Affichages
2 K
Serge6926
S
  • Résolu(e)
Microsoft 365 Remplacer une valeur saisie après recherche dans une liste sur un autre onglet
Réponses
4
Affichages
2 K
benoitoleron
V
  • Question Question
XL 2010 VBA Macro : importer les 12 caractères suivant toutes les occurrences d'un mot sur une trame word dans excel
Réponses
9
Affichages
1 K
sousou
M
  • Question Question
XL 2019 Récupérer des données dans 3 classeurs avec differents onglets
Réponses
0
Affichages
868
MathieuMC
M
C
  • Question Question
Microsoft 365 GRAPHIQUE VBA - COMMENT INDIQUER UNE VALEUR A ZERO SUR LE GRAPHIQUE
Réponses
5
Affichages
2 K
Charles78
C
S
  • Question Question
Croiser et Comparer 2 TCD
2
Réponses
16
Affichages
4 K
Skav10
S
  • Question Question
Macro pour separer un fichier excel via un champ dynamique
Réponses
2
Affichages
740
dudumomo
T
  • Question Question
Exécuter automatiquement une macro sur un fichier CSV
Réponses
1
Affichages
3 K
tb_horus
T
A
  • Question Question
Accès lecture/écriture à un fichier .xlsm par une macro
Réponses
0
Affichages
1 K
adinnn
A
A
  • Question Question
[MACRO] Help créer un fichier pdf par onglet avec nom spécifique lié à une case
Réponses
1
Affichages
2 K
MK.
M
B
  • Question Question
[RESOLU] Plusieurs boutons, plusieurs actions, mais une seule macro ?
Réponses
3
Affichages
2 K
Bayn
B
N
  • Question Question
Booster une macro
Réponses
5
Affichages
3 K
Staple1600
Menu
Connexion
S'inscrire
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…