Alimentation tableau plusieurs criteres VBA

Fermé
laurent182 Messages postés 4 Date d'inscription jeudi 4 août 2011 Statut Membre Dernière intervention 5 août 2011 - 4 août 2011 à 22:05
laurent182 Messages postés 4 Date d'inscription jeudi 4 août 2011 Statut Membre Dernière intervention 5 août 2011 - 5 août 2011 à 17:39
Bonjour à tous, je poste ici mon premier message.

Désolé pour le titre peu explicite, mais la place m'était manquée.
Voici donc mon problème

J'ai un tableau de données sous la forme :
http://img51.imageshack.us/img51/7020/tableauex.jpg
(C'est un exemple, je veux juste comprendre le principe pour l'étendre à mon application)
J'aimerais l'incrémenter avec un userform de type :
http://img109.imageshack.us/img109/2576/userformex.jpg

Jusque là je sais faire.
Maintenant j'aimerais que si pour la date selectionnée ET la personne sélectinnée, la ligne existe déja; une msgbox apparaisse pour me demander "Ces données existent déja, êtes vous sûr de vouloir les écraser? Oui/Non".
Si je répond oui, les données sont écrasées, sinon le msgbox se ferme.

Je débute en VBA et n'ai absolument aucune idée de comment procéder...
Merci pour votre aide.

Cordialement,



3 réponses

gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 686
4 août 2011 à 23:09
bonjour

Voici une idée pour résoudre ton souci :

Private Sub CommandButton1_Click()
Dim reponse
    If chercher(CDate(Me.TextBox1.Value)) Then
        reponse = MsgBox("Ces données existent déja, êtes vous sûr de vouloir les écraser? Oui/Non", vbDefaultButton1, "Attention")
        If reponse <> vbOK Then Exit Sub
    End If
    MsgBox " enregistrer"
End Sub
Public Function chercher(date_à_chercher) As Boolean
Dim lig As Long, deb As Range, sel As Range
chercher = False
Set deb = Range("A1")
Do
    Set sel = Columns(1).Cells.Find(what:=date_à_chercher, After:=deb, LookIn:=xlValues, LookAt:=xlPart)
    If sel Is Nothing Then Exit Function
    If sel.Row <= deb.Row Then Exit Function
    If sel.Offset(0, 1).Value = Me.ComboBox1.Value Then
        chercher = True
        Exit Function
    End If
    Set deb = sel
Loop
End Function

La fonction recherche la date et le nom et s'ils sont trouvés affiche le message
L'appel se fait à partir d'une textbox, tu remplace par ton contrôle date.
0
laurent182 Messages postés 4 Date d'inscription jeudi 4 août 2011 Statut Membre Dernière intervention 5 août 2011
5 août 2011 à 13:06
Merci pour ton aide gbinforme.
Ton code cherche bien si ma date est déjà dans le tableau, ça me fait bien avancer pour la suite.

Mais dans mon cas, il peut y avoir plusieurs fois la même date, mais avec des noms différents.
J'aimerais chercher la ligne où il y a la date + le nom.

Je vais explorer ta piste et peut être faire une recherche de date, puis si elle est trouvée, vérifier si le nom correspondant se trouve sur la même ligne ou non.

Si elle s'y trouve je demande confirmation, sinon je copie mes valeurs.
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 686
5 août 2011 à 17:22
une recherche de date, puis si elle est trouvée, vérifier si le nom correspondant se trouve sur la même ligne ou non

C'est exactement ce que fait ma macro avec
If sel.Offset(0, 1).Value = Me.ComboBox1.Value Then

mais si cela ne te conviens pas tu es libre de compliquer plus :)
0
laurent182 Messages postés 4 Date d'inscription jeudi 4 août 2011 Statut Membre Dernière intervention 5 août 2011
5 août 2011 à 17:39
Non je ne cherche pas à compliquer, c'est juste que je suis débutant et que je ne comprend pas chaque ligne de ton code, alors j'adapte avec ce que je sais faire :)
Mais je vais essayer.
Merci
0
laurent182 Messages postés 4 Date d'inscription jeudi 4 août 2011 Statut Membre Dernière intervention 5 août 2011
5 août 2011 à 16:43
J'ai avancé dans mes recherches et j'ai codé ça :
En gros ça cherche la date dans le tableau.
Si ça ne trouve pas ça active la fonction de copie des données.
Si ça trouve la date, ça vérifie chaque valeur jusqu'à trouver une valeur de Nom identique.
Si ça ne trouve pas, ça copie. Si ça trouve, ça me demande confirmation pour la copie.

Je sais que tout n'est pas juste, n'hesitez pas à me corriger.
Merci encore.


'Fonction Chercher'
Public Function Cherche(Date) As Boolean
Dim deb As Range
Set deb = Range("A2")
Dim reponse As Range

If Date = "" Then
MsgBox ("Erreur Date")
Else
Set reponse = Cells.Find(Date, deb, xlValues, xlPart)
If reponse Is Nothing Then
action = "ok"
Exit Function
Else
reponse_ligne = reponse.Row
If Nom.Value <> Cells(reponse_ligne, 3).Value Then
action = "ok"
Exit Function
Else

Loop

End If
End If
End If

If action Is Null Then
MsgBox ("Valeurs deja existantes, voulez vous les ecraser? Oui Non")
If resultat = "Non" Then
Exit Function
Else
action = "ok"
End If
End If

End Function

If action = "ok" Then
Incrementer(Duree).Call

'Fonction Incrementer'
Public Function Incrementer(Duree) as Boolean
Last = Range("A2").End(xlDown).Row + 1
Rows(Last).Select
Selection.Insert Shift:=xlDown
Cells(Last, 1).Value = Date.Value
Cells(Last, 2).Value = Nom.Value
Cells(Last, 3).Value = Duree.Value
End Function
0
gbinforme Messages postés 14946 Date d'inscription lundi 18 octobre 2004 Statut Contributeur Dernière intervention 24 juin 2020 4 686
5 août 2011 à 17:22
Tu devrais regarder la documentation pour connaitre le principe d'une fonction car tu me sembles bien loin d'avoir compris : une "Function" donne un résultat et n'interfère pas en dehors de son domaine comme peut le faire une procédure.
0