remplacer les données déjà inscrite (find) résolu par lone wolf et pierrejean

[fan2foot]

Bonsoir,

J'aimerais apporter une modification sur un fichier me permettant de calculer les points pour un concours de pronostic.
Le fichier fonctionne de la manière suivante, sur la feuille "pronostic" il y a un bouton nouveau pronostic qui ouvre un userform et complète le tableau de la feuille.

J'aimerais lorsque l'on clic sur enregistrer et si la valeur du combobox de l'userfom (qui correspond au pseudo du joueur) est déjà présente sur la feuille "pronostic" dans la colonne A, ( c'est ici que se remplissent les noms des joueurs dans le tableau) ouvrir une messagebox me disant " Le joueur a déjà enregistré un pronostic souhaitez-vous remplacer l'ancien pronostic ?" oui ou non. Si oui, je souhaiterais que la ligne de l'ancien pronostic du joueur soit effacée ( la ligne correspondant sur le tableau feuille "pronostic" et la ligne dans la colonne M sur la feuille "score") et remplacer par les nouvelles données de l'user forme. Sinon exit sub.
Si le joueur n'avait pas déjà enregistré un pronostic alors la procédure "normal " en remplissant la ligne vide suivante (cette fonction se fait déjà)

Une telle modification est elle possible ?

 

[Lone-wolf]

Re : Fonction écraser les données si déjà inscirte

Re fanfan,

c'est sympa d'avoir fait un nouveau classeur sans joueur

Alors vas en mode vb tape F1 et inscrit Find ou FindNext.

 

[fan2foot]

Re : Fonction écraser les données si déjà inscirte

Re fanfan,

c'est sympa d'avoir fait un nouveau classeur sans joueur

Alors vas en mode vb tape F1 et inscrit Find ou FindNext.

salut,

J'ai modifier le fichier et j'ai oubliai d'y insérer des données
Merci pour le tuyau, je vais essayer de trouver une solution a partir de ton info.
Par contre la fenêtre aide de excel ne donne aucun résultat quand je tape ces mots clé, j'ai beaucoup plus de sucés avec google.

 

[Lone-wolf]

Re : Fonction écraser les données si déjà inscirte

Normal,

j'ai pas pensé à te le dire, il faut d'abord l'inscrire dans le module, tu sélectionne le mot et normalement tu as les infos.

 

[fan2foot]

Re : Fonction écraser les données si déjà inscirte

Bonjour,

Aprés plusieurs essai, je n'ai pas réussi a trouver la solution.
Et j'arrive à un point où je ne vois pas ce qui pourrait clocher.
ca me met un message d'erreur execution "13"
et le message incompatibilité de type
Un petit coup de main s'il vous plait.

Mon code

'--- On Cherche si le joueur n'a pas déjà fait un pronostic sinon procédure ordinaire
If ComboBox1.Value = Range("A2:A100").Find([ComboBox1.Value], , lookat:=xlWhole) Then
If MsgBox("Ce joueur a déjà enregistrer un pronostic, souhaitez vous le remplacer ?", vbYesNo) = vbYes Then llProno = Range("A2:A100").Find([ComboBox1.Value], , lookat:=xlWhole) Else: Exit Sub
Else: llProno = fProno.Cells(Rows.Count, 1).End(xlUp).Row + 1
End If

 

[Lone-wolf]

Re : Fonction écraser les données si déjà inscirte

Bonsoir fandefoot,

c'est parce que tu as mal écrit ton code.

Private Sub ComboBox1_Change()
Dim reponse As String, nom As Range

With Sheets("Feuil1").Range("A2:A100")
Set nom = .Find(ComboBox1.Value, , xlValues, xlWhole)
If Not nom Is Nothing Then
reponse = MsgBox("Ce joueur a déjà enregistrer un pronostic, souhaitez vous le remplacer ?", vbYesNo)
If reponse = vbYes Then
llProno = fProno.Cells(Rows.Count, 1).End(xlUp).Row + 1
Else
Exit Sub
End If
End if
End With
End Sub

 

[fan2foot]

Re : Fonction écraser les données si déjà inscirte

Bonjour,

je n'ai plus de message d'erreur, mais le code ne marche pas, il détecte bien que le joueur à déjà enregistrer un pronostic en ouvrant une message box mais si je clic sur oui le pronostic s'écrit en dessous et non à la place de l'ancien pronostic.
J'ai essayer de modifier ton code mais je bloque sur la valeur de "llProno" quand le joueur à déjà enregister un pronostic, il faudrait écrire sur l'ancien pronostic du joueur, de manière à remplacer l'ancien par le nouveau.
Si le joueur n'a pas déjà enregistrer de pronostic alors "llProno" est égale fProno.Cells(Rows.Count, 1).End(xlUp).Row + 1 soit là dernière ligne de la feuille "pronostic".

With Sheets("Feuil2").Range("A2:A100")
Set nom = .Find(ComboBox1.Value, , xlValues, xlWhole)
If Not nom Is Nothing Then
llProno = fProno.Cells(Rows.Count, 1).End(xlUp).Row + 1
Else
reponse = MsgBox("Ce joueur a déjà enregistrer un pronostic, souhaitez vous le remplacer ?", vbYesNo)
If reponse = vbYes Then
llProno = fProno.Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
End If
End With
End Sub

 

[Lone-wolf]

Re : Fonction écraser les données si déjà inscirte

Bonjour fan2foot,

ceci n'est qu'un exemple, à toi de l'adapter. En voici d'autres

Private Sub TextBox2_Enter()
Dim cel As Range, i As Long
TextBox1.SetFocus

If TextBox1 <> "" Then
With Sheets("Base").Range("a2:j65000")
Set cel = .Find(TextBox1, , xlValues, xlWhole)
If Not cel Is Nothing Then
MsgBox "Contact déjà inscrit.", , "Contacts"
For i = 1 To 10
Me.Controls("TextBox" & i) = ""
Next
End If
End With
End If
End Sub

Private Sub CommandButton2_Click() 'Bouton Recherche
Dim cel As Range, i As Long

If ComboBox1 <> "" Then
With Sheets("Base").Range("a2:j65000")
Set cel = .Find(ComboBox1, , xlValues, xlWhole)
If Not cel Is Nothing Then
For i = 1 To 10
Me.Controls("TextBox" & i).Text = cel.Offset(0, i - 1)
Next i
TextBox7 = Format(TextBox7, "000 000 00 00")
TextBox8 = Format(TextBox8, "000 000 00 00")
Else
MsgBox "Pas de correspondant en cours.", , "Fournisseurs"
ComboBox1 = ""
For i = 1 To 9
Me.Controls("TextBox" & i).Text = ""
Next i
End If
End With
End If
TextBox10.SetFocus
End Sub

Private Sub CommandButton3_Click() 'Bouton Modification
Dim cel As Range, i As Long
If ComboBox1 <> "" Then
With Sheets("Base").Range("a2:j65000")
Set cel = .Find(ComboBox1, , xlValues, xlWhole)
If Not cel Is Nothing Then
For i = 1 To 10
cel.Offset(0, i - 1) = Me.Controls("TextBox" & i).Text
Next i
End If
End With
End If
For i = 1 To 10
Me.Controls("TextBox" & i).Text = ""
Next i
TextBox10.SetFocus
End Sub

Private Sub CommandButton4_Click() 'Bouton Annuler
Dim x As Long, k As Long, RechNom As Range, Rep

Rep = MsgBox("Voulez-vous vraiment annuler les modifications ?", vbYesNo, "Fournisseur")
If Rep = vbYes Then
For k = 1 To 10
Me.Controls("TextBox" & k).Text = ""
Next k
ComboBox1 = ""
Else
With Sheets("Base").Columns(1)
Set RechNom = .Cells.Find(TextBox1.Value)
    If RechNom Is Nothing Then
        Exit Sub
    Else
    lig = RechNom.Row
    End If
With Sheets("Base")
For x = 1 To 10
.Cells(lig, x) = Me.Controls("Textbox" & x)
If Not IsNumeric(Me.Controls("Textbox" & x)) Then
.Cells(lig, x) = Me.Controls("Textbox" & x)
Else
.Cells(lig, x) = CDbl(Me.Controls("Textbox" & x))
End If
Next x
End With
End With
End If
TextBox10.SetFocus
End Sub

 

[fan2foot]

Re : Fonction écraser les données si déjà inscirte

bonjour,

merci du coup de main lone wolf, sa m'a permis de bien me diriger mais je t'avoue qu’après une journée d’échec, je fait du surplace.
Mon dernier echec c'était avec ce code

Set fScore = Feuil7
Set fProno = Feuil2
Set rProno = Feuil2.Range("A2:A100")
Dim llProno As Long
Dim reponse As String
Dim nom As Range, doublon As Integer

Set nom = rProno.Find(ComboBox1.Value, , xlValues, xlWhole)
If Not nom Is Nothing Then
reponse = MsgBox("Ce joueur a déjà enregistrer un pronostic, souhaitez vous le remplacer ?", vbYesNo)
If reponse = vbYes Then
doublon = nom.Row
llProno = fProno.Cells(doublon)
Else
Exit Sub
End If
End If

  llProno = fProno.Cells(Rows.Count, 1).End(xlUp).Row + 1

j'ai un message d'erreur me disant qu'il y a un problème avec "llProno".
j'ai aussi trouver un sujet presque similaire au mien sur le forum mais je ne sais pas si il est adaptable.
https://www.excel-downloads.com/threads/ecraser-des-donnees-dans-une-base-de-donnees-excel.108740/

je met aussi en PJ mon fichier entier, car juste avec le morceaux de code j'imagine que ce n'est pas évident.

 

[pierrejean]

Re : Fonction écraser les données si déjà inscirte

Bonjour fan2foot

Salut Lone-wolf

Vois si cela va mieux

 

[fan2foot]

Re : Fonction écraser les données si déjà inscirte

Bonjour MR pierrejean,

Un grand merci, c'est ce que je cherchais à faire. Finalement j'étais pas loin de trouver sans jamais y arriver, encore merci car je t'avoue que j'étais pas loin d' arrêter l'idée de créer cette fonction a mon fichier, qui me sera pourtant bien utile.
J'ai juste modifier un petit peu, et c'est maintenant parfait
si quelqu'un cherche un jour, de faire pareil et cherche le codage je met le code

Set fScore = Feuil7
Set fProno = Feuil2
Set rProno = Feuil2.Range("A2:A100")
Dim llProno As Long
Dim reponse As String
Dim nom As Range, doublon As Integer

Set nom = rProno.Find(ComboBox1.Value, , xlValues, xlWhole)
If nom Is Nothing Then
llProno = fProno.Cells(Rows.Count, 1).End(xlUp).Row + 1
End If
If Not nom Is Nothing Then
reponse = MsgBox("Ce joueur a déjà enregistrer un pronostic, souhaitez vous le remplacer ?", vbYesNo)
   If reponse = vbYes Then
    doublon = nom.Row
    llProno = doublon
  Else: Exit Sub
  End If
End If

PS: j'ai une dernière question a vous poser, comment vous intégrez un code vba en commentaire ? ( je veux dire sur le forum) Je ne trouve que la balise "code" simple

 

[fan2foot]

Re : Fonction écraser les données si déjà inscirte

en continuant d'autres essai, je viens de me rendre compte que le code ne marche pas sur mon ancien fichier, mais seulement sur celui que tu as envoyé.
Peux tu me dire ce que tu as changé d'autre que ce morceaux de codage ?

 

[Lone-wolf]

Re : remplacer les données déjà inscrite (find) résolu par lone wolf et pierrejean

Bonsoir fan2foot, pierrejean

fanfan à qui est adressé la question?. Pour le code vba c'est la balise CODE (#) qu'il faut utiliser. Pour le commentaire c'est le premier icône à droite (légende ou bulle) comme celui utilisé dans les bandes dessinées.

pour ce code-ci, si tu l'utilise

Sub Macro5()
    Columns("I:I").Select
    Range("I2").Activate
    ActiveWorkbook.Worksheets("Classement").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Classement").Sort.Fields.Add Key:=Range("I2") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Classement").Sort
        .SetRange Range("H2:I101")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

Peux se résumer comme ceci

With Sheets("Classement")
.Range("H2:I101").Sort  .Range("i2"),   xlDescending
End with

 

[pierrejean]

Re : remplacer les données déjà inscrite (find) résolu par lone wolf et pierrejean

Re

Regarde du coté de
"J'ai juste modifier un petit peu, et c'est maintenant parfait"

 

[Lone-wolf]

Re : remplacer les données déjà inscrite (find) résolu par lone wolf et pierrejean

@pierrejean :