XL 2010 Fonction Id existe

cathodique · 5 Avril 2024

Bonjour,

Je voudrais créer une fonction renvoyant un booléen pour savoir si un N° Id existe déjà.
J'ai fait cette procédure qui compte les occurrences. Je ne vois comment la transformer en fonction.
Dans le fichier ci-joint le NoId est dans cellule, dans mon fichier de travail il est dans une TextBox.

VB:

Sub No_Existe()
   Dim Kit As Boolean, quoi, où As Range, col As Integer
   quoi = Feuil1.Range("i1").Value
   Set où = Feuil1.Range("Tb[No_Id]")

   If Application.CountIf(où, quoi) = 0 Then
      Kit = False
   Else
      Kit = True
   End If

   Set où = Nothing
End Sub

En vous remerciant.

Bonne journée.

wDog66 · 5 Avril 2024

Bonjourt Cathodique,

La fonction est simple à faire

VB:

Function No_Existe(Quoi)
   Set où = Feuil1.Range("Tb[No_Id]")
   No_Existe = Application.CountIf(où, quoi) = 0
   Set où = Nothing
End Sub

Et s'appelle avec un test

INI:

If No_Exist(Feuil1.Range("i1")) Then
  Msgbox "Ok n'existe pas"
End If

Bonne journée

gbinforme · 5 Avril 2024

Bonjour à tous
Une façon un peu différente :

VB:

Public Function ID_Existe(quoi As Range, où As Range)
   If Application.CountIf(où, quoi) = 0 Then
      ID_Existe = False
   Else
      ID_Existe = True
   End If
End Function

bof · 5 Avril 2024

Bonjour,
Plus simplement :

VB:

Function No_Existe(quoi$) As Boolean
   No_Existe = Application.CountIf(Range("Tb[No_Id]"), quoi)
End Function

Attention il y a de nombreux espaces parasites colonne 1 soit au début soit en fin de chaine : cela risque de donner des résultats aléatoires...
A+

cathodique · 5 Avril 2024

bof à dit:
Bonjour,
Plus simplement :

VB:

Function No_Existe(quoi$) As Boolean No_Existe = Application.CountIf(Range("Tb[No_Id]"), quoi) End Function

Attention il y a de nombreux espaces parasites colonne 1 soit au début soit en fin de chaine : cela risque de donner des résultats aléatoires...
A+

Bonjour @wDog66, @gbinforme, @bof ,

Je ne m'attendais pas à autant de réponse en un si court instant.
Je constate que relative simple de créer une fonction.
Je vous remercie beaucoup.

Passez une excellente journée.

patricktoulon · 5 Avril 2024

Bonjour à tous

j’étais en train de répondre et bof a été plus rapide et a tout dit

1°une fonction est sensée renvoyer une valeur , un object
2° donc on type le return de la fonction
par conséquent pas besoin de coder un if else on code l'affirmation qui sera négative si le countif est 0

cathodique · 5 Avril 2024

bof à dit:
Attention il y a de nombreux espaces parasites colonne 1 soit au début soit en fin de chaine : cela risque de donner des résultats aléatoires...

Je te remercie de me l'avoir signaler.
En fait, cette colonne est remplie à partir d'une textbox formatée.
Le format est ainsi xxx xxx xxx xxx xxx xxx (18 caractères: Chiffre ou lettre).
Cependant, certains No d'identification (ancien) ont moins de 18 caractères.
Et, dans la textbox on ne peut pas supprimer les x.
Pour pallier à ceci j'enregistre comme ci-dessous

VB:

Lig.Range.Cells(9).Value = Replace(TxtNo_Id, "x", "")

Je remplace les x par caractère vide.
Si tu as une autre solution, je suis preneur.

Bonne journée.

cathodique · 5 Avril 2024

patricktoulon à dit:
Bonjour à tous

j’étais en train de répondre et bof a été plus rapide et a tout dit

1°une fonction est sensée renvoyer une valeur , un object
2° donc on type le return de la fonction
par conséquent pas besoin de coder un if else on code l'affirmation qui sera négative si le countif est 0

Bonjour @patricktoulon ,

Content que tu l'as, Le code de formatage est le tien trouvé sur XLD que j'ai adapté à mes besoins.
Par contre, je n'ai pas su ajouter la touche Supp pour effacer les x en trop.
Car comme je viens de le dire à @bof, les numéros ont parfois 15, 18 et quelques fois moins de 15 (ancien n°).
Tu reconnais ton code

Code:

Private Sub txtb_KeyDown(txtb As Object, KeyCode, mask$, Optional letters As Boolean = False, Optional num As Boolean = False)
'Code PatrickToulon
'MsgBox KeyCode
   Dim txt$, s&, longg&, plus&
   If num = False And letters = False Then num = True
   If txtb = "" And KeyCode <> 8 And KeyCode <> 46 Then txtb = mask
   txt = txtb.Value: If txt = mask Then txtb.SelStart = 0
   s = txtb.SelStart:
   longg = txtb.SelLength: If longg = 0 Then longg = 1
   plus = IIf(KeyCode < 96, 32, -48):
   Select Case KeyCode
   Case IIf(num = True, 96, 65) To IIf(num = True, 105, 90), IIf(letters = True, 65, 96) To IIf(letters = True, 90, 105)
      If s = Len(mask) Then KeyCode = 0: Exit Sub
      If Mid(mask, s + 1, 1) <> "x" Then KeyCode = 0: s = s + 1: txtb.SelStart = s: Exit Sub
      Mid(txt, s + 1, longg) = IIf(Val(txtb.Tag) = 0, Chr(KeyCode + plus), UCase(Chr(KeyCode + plus))) & Mid(mask, s + 2, longg - 1): KeyCode = 0
      txtb = txt: txtb.SelStart = IIf(InStr(1, txtb, "x") = 0, s + 1, InStr(1, txtb, "x") - 1)

   Case 8
      If s <> 0 Then Mid(txt, s, longg + 1) = Mid(mask, s, longg + 1) Else Exit Sub
      txtb = txt: txtb.SelStart = s - 1: KeyCode = 0: If txt = mask Then txtb = ""

   Case 46
      If txtb = "" Then Exit Sub
      If longg = 0 Then longg = 1
      Mid(txt, s + 1, longg) = Mid(mask, s + 1, longg)
      txtb = txt: txtb.SelStart = s: KeyCode = 0: If txt = mask Then txtb = ""

   Case 39: txtb.SelStart = s + 1
   Case 37: txtb.SelStart = s - IIf(s > 0, 1, 0)
   Case 20: If Val(txtb.Tag) = 0 Then txtb.Tag = 1 Else txtb.Tag = 0
   Case 16: txtb.Tag = 1
   Case 13:   ' touche enter  fait ce que tu veux c'est la sortie
   Case Else: KeyCode = 0
   End Select
End Sub

Merci. Bonne journée.

patricktoulon · 5 Avril 2024

bonjour @cathodique
c'est quoi l'appel
c'est quoi le mask

patricktoulon · 5 Avril 2024

d'accord en remontant a la reponse précedente j'ai pigé
donc 18 caractères "x" pour le mask
mais il se peut qu'il y en ai moins et les "x" en trop doivent disparaitre l'ors de la retranscription sur cellule
c'est ça

patricktoulon · 5 Avril 2024

re

VB:

Lig.Range.Cells(9).Value  = Trim(Split(Txt_No, "x")(0))

cathodique · 5 Avril 2024

patricktoulon à dit:
re

VB:

Lig.Range.Cells(9).Value = Trim(Split(Txt_No, "x")(0))

Bonjour @patricktoulon ,

Merci beaucoup pour ton intervention et ta proposition.
Je suis sûr qu'elle fonctionne. Cependant, le Trim va supprimer tous les espaces.
Le même formatdoit rester dans la cellule. Je voudrais juste supprimer les 'x' de la fin.
exemple: Saisie dans textbox --- > 555 654 326 312 xxx xxx
Je ne sais pas quel évènement de la textbox utiliser car c'est la dernière textbox à renseigner avant de valider l'enregistrement. Pour afficher dans la textbox ---> 555 654 326 312, déjà pour vérifier si le code n'existe pas éventuellement dans la BD. Pour ensuite, faire l'enregistrement dans la cellule au même format
soit 555 654 326 312.

J'espère que cette fois-ci, je suis clair.

Merci beaucoup.

patricktoulon · 5 Avril 2024

re
non:!! le trim ne supprimera pas les espaces intermédiaires

cathodique · 5 Avril 2024

patricktoulon à dit:
re
non:!! le trim ne supprimera pas les espaces intermédiaires

C'est parfait alors. Je t'avoue que je saute du coq à l'âne. J'ai tellement de chose à faire.
Merci beaucoup.

XL 2010 Fonction Id existe

cathodique

XLDnaute Barbatruc

Pièces jointes

wDog66

XLDnaute Occasionnel

gbinforme

XLDnaute Impliqué

Pièces jointes

bof

XLDnaute Occasionnel

cathodique

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

cathodique

XLDnaute Barbatruc

Discussions similaires