اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

  • أفضل إجابة
قام بنشر

السلام عليكم

استخدم الكود التالي

Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim m
On Error GoTo 1
m = WorksheetFunction.Match(CStr(Me.TextBox1), Range("a1:a6"), 0)
1:
If Err Then
    MsgBox "القيمة غير موجودة في القائمة"
    Err.Clear
    Cancel = True
End If
End Sub

 

في امان الله

قام بنشر

الاخ عبد الله

اسف لاننى لم اجرب الكود جيدا

ولكن عن ملئ المدى المحدد فى الكود بالارقام

مثلا من الرقم 1 الى 5

وعند كتابة الرقم 1 فى التيكست بوكس

الا ان الرساله تظهر ان الرقم خطأ

مع انه صحيح

ارجو التعديل

قام بنشر

السلام عليكم

 

بعد اذن استاذي عبدالله

 

جرب التعديل التالي على الكود

 

Private Sub Ent_a()
Dim m
On Error GoTo 1
m = WorksheetFunction.Match(CStr(Me.TextBox1), Range("a1:a6"), 0)
1:
If Err Then
    MsgBox "القيمة غير موجودة في القائمة"
    TextBox1 = ""
    Err.Clear
End If
End Sub
Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
 Select Case KeyCode
     Case 1 To 46
      If Not TextBox1 = "" Then Ent_a
 End Select
End Sub
Private Sub UserForm_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
  If Not TextBox1 = "" Then Ent_a
End Sub
 

قام بنشر

بعد اذن  أستاذى الحبيب / عبد الله باقشير

وبعد اذن أخى الحبيب / عباد

هذه مشاركة متواضعة

لعلها تلقى قبول اساتذتى الكرام

 

Private Sub TextBox1_Change()
For Each cl In [A1:A6]
arr = arr & cl & ","
Next
x = UBound(Filter(Split(arr, ","), TextBox1))
If x = -1 Then MsgBox "القيمة غير موجودة في القائمة": Exit Sub
End Sub

 

 

TEXTBOX1.rar

  • Like 1
قام بنشر

السلام عليكم

الاساتذة الكرام

طبعاً الدخول في موضوع لكم وردود بهذه الروعة تعتبر انتحار

ولن اقدم كوداً جديداً ولكن

كود الاستاذ العلامة القدير / عبد الله باقشير  ... جزاه الله خيراً

فعلاً يعطي خطأ حتي في حالة وجود الرقم الصحيح

واعلم ان لديه التعديل الاروع كعادته

 

وتعديل الكود من الكبير جداً / عباد .... جزاه الله خيراً

لم يعمل لدي ... ولا اعلم السبب

 

والكود المقدم من العملاق الكبير / رجب جاويش  .... جزاه الله خيراً

راائع واظن انه يفي بالمطلوب بصورة ممتازة

وعند التجربة اضفت لمسه بسيطة جداً والاكيد ان الفضل الاول له لاكمال العملية

حيث عندما يقوم الادخال فعلا يعطي الرسالة ولكنه يبقي علي القيمة الموجودة في التكست

فجعلت الكود يمسح ما به بعد الضغط علي الرسالة التي تظهر

ارجو ان اكون وفقت في ذلك

 

جزاكم الله خيرا

 

textbox2.rar

قام بنشر

الاستاذ الفاضل / رجب جاويش التعديل اكثر من رائع ولكن اذا تكرمت تشرح لنا هذا الكود خاصة السطر

 

x = UBound(Filter(Split(arr, ","), TextBox1))
 
و ارجو توضيح الفرق بين        (Match(TextBox17.Value)   و  (Match(CStr(Me.TextBox1  و (Match(Val(TextBox17.Value
 
وجزاك الله خيرا
قام بنشر

أخى الحبيب / حمادة عمر

شكرا جزيلا اخى الحبيب على كلماتك الطيبة التى تعطينى أكثر مما أستحق

وتسلم ايديك على هذه اللمسات الجميلة

قام بنشر (معدل)

<p>أخى الفاضل / حسين</p>

<p>هذا السطر</p>

<p>x = UBound(Filter(Split(arr, &quot;,&quot;), TextBox1))</p>

<p>يقوم بعمل فلترة للبيانات الموجودة فى المتغير arr&nbsp; وشرط الفلترة هو القيمة المكتوبة فى Textbox&nbsp;</p>

<p>ثم بعد ذلك تقوم الدالة ubound&nbsp; بايجاد قيمة الحد الأعلى للمصفوفة الناتجة عن الفلترة</p>

<p>فاذا كانت قيمة الحد الأعلى ( x ) يساوى -1 معنى ذلك أنه لا يحتوى على بيانات</p>

<p>مما يعنى أن قيمة ال Textbox غير موجودة فى نطاق البيانات [ A1:A6] فتظهر الرسالة التى تخبرنا بذلك</p>

تم تعديل بواسطه رجب جاويش
  • Like 1
قام بنشر (معدل)

أما السطور

   (Match(TextBox17.Value)

فان دالة Match هى دالة بحث تبحث عن عنصر معين ( هو هنا قيمة الـ  TextBox17 ) داخل نطاق معين من الخلايا وترجع الموقع النسبى لهذا العنصر فى النطاق

أما الجزء

(Match(CStr(Me.TextBox1

فيزيد عليه الجزء CStr وهو يقوم بتحويل قيمة الـ TextBox1 الى متغير من نوع String  ( نصى )

أما الجزء

(Match(Val(TextBox17.Value

فيزيد عليه الجزء Val وهى تأخذ القيمة الرقمية من الـ TextBox1 للبحث عنها حيث أنها تحول القيمة النصية لرقم مثل " 3 " ( لاحظ الأقواس الصغيرة " " حول الرقم وهى تسمى علامات التنصيص )  تحولة الى رقم 3

 

أرجو أن أكون وفقت فى الشرح وأن يكون واضح

وعذرا لأى خطأ

والله أعلم

تم تعديل بواسطه رجب جاويش
قام بنشر

السلام عليكم

الاستاذ الكبير / رجب جاويش

 

رااائع دائماً كعادتك في اكواد وفي شرحك الاروع

بارك الله فيك استاذنا

وجزاك الله خيراً

قام بنشر

السلام عليكم

الشكر واصل لجميع احبتي المشاركين

 

هذا تعديل الكود ليشمل البحث على نص او رقم

 

Private Sub TextBox1_BeforeUpdate(ByVal Cancel As MSForms.ReturnBoolean)
Dim m, v
On Error GoTo 1
v = Me.TextBox1
If IsNumeric(v) Then v = Val(v)
m = WorksheetFunction.Match(v, Range("a1:a6"), 0)
1:
If Err Then
    MsgBox "القيمة غير موجودة في القائمة"
    Err.Clear
    Cancel = True
End If
End Sub
 

في امان الله

قام بنشر

السلام عليكم

ملحوظة لاخي الحبيب رجب ----حفظه الله

الدالة النصية  Filter

تمرر البحث بجزئية من النص الذي تبحث فيه

لو فرضنا ان الرقم 1 غير موجود في القائمة

والرقم 11 موجود في القائمة

فلو كتبت 1 ستمرره الدالة

 

تقبل تحياتي وشكري

قام بنشر

أستاذى الحبيب / عبد الله باقشير

دمت لنا معلما وموجها وبحر علم ننهل منه المزيد كل يوم

حفظك ربى منارة لهذا المنتدى ولجميع محبيك وتلاميذك

تلميذك المحب لك دائما

رجب جاويش

قام بنشر

السلام عليكم

الاستاذ القدير العلامة الخبير / عبدالله باقشير

 

نعم ستظل انت المنارة التي نهتدي بها للصواب دائما

وقد ذكرت قبل ذلك في المشاركة السابقة انه دائما لديك الاروع

كم انت كبير استاذنا

تلميذ تلميذك المحب لك في الله حقاً

جزاك الله خيراً

زائر
هذا الموضوع مغلق.
×
×
  • اضف...

Important Information