Sub ExtraireResultats()
Dim ws As Worksheet, wsResult As Worksheet
Dim lastRow As Long, resultRow As Long, i As Long
Dim clientName As String, roomNumber As String
Dim dateArrivee As Variant, dateDepart As Variant
Dim montantPaiement As Double, modePaiement As String
Dim cellContent As String, dates() As String
Dim startPos As Long, endPos As Long
Dim Decalage As Integer, Facture, NumFacture
' Définir la feuille active et la feuille de résultats
Set ws = ThisWorkbook.Sheets(1) ' Ajustez le numéro de la feuille si nécessaire
On Error Resume Next
Set wsResult = ThisWorkbook.Sheets("Résultat")
On Error GoTo 0
' Créer la feuille "Résultat" si elle n'existe pas
If wsResult Is Nothing Then
Set wsResult = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
wsResult.Name = "Résultat"
End If
' Effacer les anciennes données dans la feuille Résultat
wsResult.Cells.Clear
' En-têtes de la feuille Résultat
wsResult.Cells(1, 1).Value = "Nom du Client"
wsResult.Cells(1, 2).Value = "Numéro de Chambre"
wsResult.Cells(1, 3).Value = "Date d'Arrivée"
wsResult.Cells(1, 4).Value = "Date de Départ"
wsResult.Cells(1, 5).Value = "N° Facture"
wsResult.Cells(1, 6).Value = "Montant Paiement"
wsResult.Cells(1, 7).Value = "Mode de Paiement"
' Déterminer la dernière ligne des données dans la feuille d'origine
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
' Initialiser la ligne pour les résultats
resultRow = 2
' Parcourir les lignes de la feuille d'origine
For i = 2 To lastRow
cellContent = ws.Cells(i, 1)
If InStr(cellContent, "SEJOUR :") > 0 Then
Dim pos1 As Long, pos2 As Long, pos3 As Long
Dim tempName As String
' Récupérer le contenu des cellules A et B et C
cellContent = ws.Cells(i, 1) & ws.Cells(i, 2) & ws.Cells(i, 3)
'Regarder si il y a quelque chose en colonne C
If Not IsEmpty(ws.Cells(i, 3)) Then Decalage = 1 Else Decalage = 0
' Trouver la position de "SEJOUR :" et "CHB:"
pos1 = InStr(cellContent, "SEJOUR :") + 8 ' Position après "SEJOUR :"
pos2 = InStr(cellContent, "/") ' Trouver la position du "/"
pos3 = InStr(cellContent, "CHB:") + 4 ' Position après "CHB:"
' Extraire le nom du client entre "SEJOUR :" et "/"
If pos1 > 0 And pos2 > 0 Then
tempName = Trim(Mid(cellContent, pos1, pos2 - pos1)) ' Extraire le nom du client
Else
tempName = "" ' Si le format est incorrect, laisser le nom vide
End If
' Extraire le numéro de chambre après "CHB:"
If pos3 > 0 Then
roomNumber = Trim(Mid(cellContent, pos3)) ' Extraire le numéro de chambre
Else
roomNumber = "" ' Si "CHB:" est absent, laisser le numéro de chambre vide
End If
' Assignation des résultats
clientName = tempName
End If
' Extraire le numéro de facture
If InStr(cellContent, "FACTURE No : ") > 0 Then
Facture = Split(cellContent, ":")
NumFacture = Trim(Facture(1))
End If
' Extraire les dates de la colonne A (format "DU xx.xx.xxxx AU xx.xx.xxxx")
If InStr(cellContent, "DU") > 0 And InStr(cellContent, "AU") > 0 Then
dates = Split(cellContent, "AU")
' Extraire la date d'arrivée après "DU"
dateArrivee = Trim(Mid(dates(0), InStr(dates(0), "DU") + 3)) ' Extraire la date après "DU"
' Extraire la date de départ après "AU"
dateDepart = Trim(dates(1))
' Convertir les dates au format DateValue, en remplaçant les points par des slashes pour qu'Excel puisse les interpréter
On Error Resume Next
dateArrivee = DateValue(Replace(dateArrivee, ".", "/")) ' Convertir la date d'arrivée en Date
If Err.Number <> 0 Then
dateArrivee = "" ' Si erreur de conversion, mettre une date vide
Err.Clear
End If
dateDepart = DateValue(Replace(dateDepart, ".", "/")) ' Convertir la date de départ en Date
If Err.Number <> 0 Then
dateDepart = "" ' Si erreur de conversion, mettre une date vide
Err.Clear
End If
On Error GoTo 0
End If
montantPaiement = 0
' Vérifier si le montant du paiement dans la colonne F ou E est numérique et s'il est négatif
If IsNumeric(ws.Cells(i, 5 + Decalage).Value) Then
montantPaiement = ws.Cells(i, 5 + Decalage).Value
If montantPaiement < 0 Then
' Extraire le mode de paiement (colonne B)
modePaiement = ws.Cells(i, 2).Value
' Enregistrer dans la feuille de résultats
wsResult.Cells(resultRow, 1).Value = clientName ' Nom du Client
wsResult.Cells(resultRow, 2).Value = roomNumber ' Numéro de Chambre
wsResult.Cells(resultRow, 3).Value = dateArrivee ' Date d'Arrivée
wsResult.Cells(resultRow, 4).Value = dateDepart ' Date de Départ
wsResult.Cells(resultRow, 5).Value = NumFacture ' Numéro de facture
wsResult.Cells(resultRow, 6).Value = montantPaiement ' Montant Paiement
wsResult.Cells(resultRow, 7).Value = modePaiement ' Mode de Paiement
resultRow = resultRow + 1
End If
End If
Next i
' Message de fin d'exécution
MsgBox "Extraction terminée!"
End Sub
