XL 2016 Problème lors de recherche croisée.

Xender · 5 Décembre 2023

Bonjour,

Je me permet de venir vers vous car j'ai un souci de format je pense.
Je vais essayé de m'expliqué le plus clairement possible.

L'état d'avancement du fichier n'est pas fini donc rien n'est très "esthétique" ^^

J'ai donc un fichier qui me sert à la gestion de planning ect. (que j'ai récupéré d'une autre personne)

J'ai mis en place des UserForm pour les Utilisateurs qui feront leur demande.
Dans l'onglet "Demande Chantier" il ont accès à trois bouton de demande.
Le bouton Demande de personnel est fonctionnel.
Ou je rencontre un problème c'est avec les bouton "Demande Géomètre" et "Demande équipe de finition".

Nous allons utiliser "Demande équipe de finition"

Ensuite mon UserForm s'ouvre sur le bon onglet :

La date de demande doit être chercher dans la ligne 3 (rouge)
La chantier dans la colonne D (vert)
A l'intersection de la date trouvé et du chantier trouver il faut juste mettre "1"

J'ai donc ce code qui est cesser me permettre de faire ce dont j'ai besoin mais je n'arrive pas à trouver de date dans la ligne 3.
Je pense avoir un souci de format ou autre je ne comprend pas d'ou viens le souci. Cela doit s'effectuer avec le bouton "Valider ma demande".

VB:

Private Sub BT_Validation_Click()

    Dim ws As Worksheet
    Dim lastColumn As Long
    Dim dateCol As Long
    Dim chantierRow As Long
    
    ' Référence à la feuille de calcul
    Set ws = ActiveSheet

   ' Recherche de la colonne contenant la date
dateCol = 0
startColumn = 4 ' Column D
lastColumn = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Column
For i = startColumn To lastColumn
    If ws.Cells(3, i).Value = TXT_Date.Value Then
        dateCol = i
        Exit For
    End If
Next i

If dateCol = 0 Then
    MsgBox "Date non trouvée dans la ligne 3."
    Exit Sub
End If

    ' Recherche du chantier dans la colonne D
    chantierRow = 0
    lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).row
    For i = 1 To lastRow
        If ws.Cells(i, 4).Value = LST_Chantier.Value Then
            chantierRow = i
            Exit For
        End If
    Next i

    If chantierRow = 0 Then
        MsgBox "Chantier non trouvé dans la colonne D."
        Exit Sub
    End If

    ' Inscrire 1 à l'intersection de la date et du chantier
    ws.Cells(chantierRow, dateCol).Value = 1


End Sub

Je vous join également le fichier.

J'espère être assez claire dans mes explication, je reste à votre disposition si vous avez des questions.

Cordialement.

Xender · 6 Décembre 2023

Bonjour ChTi160 et Sousou, merci pour vos réponse. J'ai réussi à m'en sortir avec votre aide. Voici le code qui m'a permis de gérer le problème

VB:

 Dim ws As Worksheet
    Dim lastColumn As Long
    Dim dateCol As Long
    Dim chantierRow As Long

    ' Référence à la feuille de calcul
    Set ws = ActiveSheet

   ' Recherche de la colonne contenant la date
    dateCol = 0
    startColumn = 4 ' Column D
    lastColumn = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Column
    For i = startColumn To lastColumn
    madate = CDate(TXT_Date.Value)
    
    If ws.Cells(3, i) = madate Then
    dateCol = i
    Exit For
    End If
    Next i


    If dateCol = 0 Then
        MsgBox "Date non trouvée dans la ligne 3."
        Exit Sub
    End...

ChTi160 · 5 Décembre 2023

Bonsoir
j'ai juste modifié la colonne de départ de la recherche (6 au lieu de 4) et ajouter CDate() au TextBox et je trouve une Colonne en retour
à voir Donc pas testé autre chose

VB:

startColumn = 6 ' Column F
lastColumn = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Column
For i = startColumn To lastColumn
    If ws.Cells(3, i).Value = CDate(TXT_Date.Value) Then
        dateCol = i
        Exit For
    End If
Next i

Je vois que tu as parfois plusieurs 1 successifs, comment fais-tu ? Date par Date ?
N'hésite pas si besoin !
Jean marie

sousou · 5 Décembre 2023

Bonjour

1/ Plusieurs choses, tu devrais traiter tes dates comme des dates et non pas comme du texte.
2/ tous va dépendre de la saisie préconisée:
Dans le cas ici, l'année est dans une textbosx et le jour et le mois dans une autre.
A savoir que les textbox ne renvoient que du texte.
Dans l'exemple je saisie 1/9 et 2023
J'effectue une conversion en date avec cdate()
et là il va trouver.
La condition est que la saisie soit conforme à une expression date
Il serait préférable me semble t'il de supprimer l'année,
de proposer de saisir une date entière 1/9/202 par exemple, et de vérifier si l'expression est une date avec isdate() ava,nt de la recherchée.
Je ne vais pas plus loin........

startColumn = 4 ' Column D
lastColumn = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Column
For i = startColumn To lastColumn
madate= CDate(TXT_Date.Value & "/" & Me.LST_Année)

If ws.Cells(3, i) = madate Then
dateCol = i
Exit For
End If
Next i

ChTi160 · 5 Décembre 2023

Re
Ce que j'ai modifié dans "BT_Validation_Click"

VB:

Private Sub BT_Validation_Click()
    Dim ws As Worksheet
    Dim DateSearch As Long
    Dim ColonneDate As Long
    Dim ChantierSearch As String
    Dim LigneChantier As Integer
     ' On va utiliser la fonction Match pour trouver la colonne correspondant à DateSearch et la Ligne correspondant à ChantierSearch
     ' Référence à la feuille de calcul
       Set ws = ActiveSheet
         DateSearch = CLng(CDate(Me.TXT_Date.Value))
    ChantierSearch = Trim(Me.LST_Chantier.Value)
        ' Recherche de la date sur la Ligne 3
    If Not IsError(Application.Match(CLng(dateDuJour), ws.Rows(3), 0)) Then
        ' La date a été trouvée
          ColonneDate = Application.Match(CLng(DateSearch), ws.Rows(3), 0)
       Else
        ' La date n'a pas été trouvée dans la plage spécifiée
        MsgBox "La date n'a pas été trouvée dans la plage spécifiée."
              Exit Sub 'On quitte
    End If
         ' Recherche du chantier dans la colonne D
    If Not IsError(Application.Match(ChantierSearch, ws.Columns(4), 0)) Then
 
    LigneChantier = Application.Match(LST_Chantier.Value, ws.Columns(4), 0)
        Else
        ' Le Chantier n'a pas été trouvé dans la plage spécifiée
        MsgBox "Chantier non trouvé dans la colonne D."
              Exit Sub 'On quitte
    End If
        ' Inscrire 1 à l'intersection de la date et du chantier
      ws.Cells(LigneChantier, ColonneDate).Value = 1
End Sub

à voir
N'hésite pas si besoin !
Jean marie

Xender · 6 Décembre 2023

Bonjour ChTi160 et Sousou, merci pour vos réponse. J'ai réussi à m'en sortir avec votre aide. Voici le code qui m'a permis de gérer le problème

VB:

 Dim ws As Worksheet
    Dim lastColumn As Long
    Dim dateCol As Long
    Dim chantierRow As Long

    ' Référence à la feuille de calcul
    Set ws = ActiveSheet

   ' Recherche de la colonne contenant la date
    dateCol = 0
    startColumn = 4 ' Column D
    lastColumn = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Column
    For i = startColumn To lastColumn
    madate = CDate(TXT_Date.Value)
    
    If ws.Cells(3, i) = madate Then
    dateCol = i
    Exit For
    End If
    Next i


    If dateCol = 0 Then
        MsgBox "Date non trouvée dans la ligne 3."
        Exit Sub
    End If


' Recherche de la ligne contenant le chantier
    chantierRow = 0
    startRow = 5 ' Row 5
    lastRow = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Column
    For i = startRow To lastRow
        If ws.Cells(i, 4) = LST_Chantier.Value Then
    chantierRow = i
    Exit For
    End If
    Next i


    If chantierRow = 0 Then
        MsgBox "Chantier non trouvé dans la colonne D."
        Exit Sub
    End If


    ' Inscrire 1 à l'intersection de la date et du chantier
    ws.Cells(chantierRow, dateCol).Value = 1
    ws.Cells(chantierRow, dateCol).Font.Color = RGB(0, 0, 0)
    
    ' Vérifier si un "1" est déjà présent dans la colonne de la date
For j = startRow To lastRow
    If ws.Cells(j, dateCol).Value = 1 And j <> chantierRow Then
        ' Si un "1" est trouvé, changer la couleur de tous les "1" dans la colonne en rouge
        For i = startRow To lastRow
            If ws.Cells(i, dateCol).Value = 1 Then
                ws.Cells(i, dateCol).Font.Color = RGB(255, 0, 0)
            End If
        Next i
        Exit For
    End If
Next j

J'ai rajouté une petite fonctionnalité. Encore merci pour votre aide !

XL 2016 Problème lors de recherche croisée.

Xender

XLDnaute Nouveau

Pièces jointes

Xender

ChTi160

XLDnaute Barbatruc

sousou

XLDnaute Barbatruc

ChTi160

XLDnaute Barbatruc

Xender

XLDnaute Nouveau

Discussions similaires