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

كود بحث في صفحتين لا يعمل

طارق نادر

بواسطه طارق نادر
في منتدى الاكسيل Excel

 مشاركة

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

طارق نادر

طارق نادر

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

ارفق الكود بعد التعديل من قيل اخواني الكرام ولكن بقيت المشكلة قد يكون السبب قلة دقتي في التعديل المطروح من قبل الاخوان الافاضل لذا سارفق الكود والملف لكي يتسنى لكم مساعدتي لطفا

الرقم السري للملف tareq972708 

Private Sub CommandButton1_Click()
On Error Resume Next

Dim i As Integer, LastR As Long, ws, ws1 As Worksheet
Set ws = ThisWorkbook.Sheets("البيانات")
Set ws1 = ThisWorkbook.Sheets("المدراء")

LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1
LastRow1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row + 1

For i = 2 To 15
UserForm1.ComboBox1.Clear
For T = 2 To LastRow


If OptionButton1.Value = True Then
        
    If TextBox1.Text = Mid(ws1.Cells(S, 3).Text, 1, Len(TextBox1.Text)) Then


        UserForm1.ComboBox1.AddItem ws1.Cells(S, 3)
        UserForm1.Controls("TextBox" & i).Value = ws1.Cells(S, i).Value
        UserForm1.CommandButton4.Enabled = True
        Unload Me
    End If
Else
If OptionButton2.Value = True Then
        If TextBox1.Text = Mid(ws.Cells(T, 3).Text, 1, Len(TextBox1.Text)) Then
        UserForm1.ComboBox1.AddItem ws.Cells(T, 3)
        UserForm1.Controls("TextBox" & i).Value = ws.Cells(T, i).Value
        UserForm1.CommandButton4.Enabled = True
        Unload Me
        End If
End If
End If
Next
Next
UserForm1.ComboBox1.ListIndex = 0

If UserForm1.TextBox2.Text = "" Then MsgBox "åÐÇ ÇáãæÙÝ ÛíÑ ãæÌæÏ", vbInformation + vbMsgBoxRight, "äÊíÌÉ ÇáÈÍË"
UserForm1.CommandButton3.Enabled = False
End Sub

 

2017صيفية برمجية استعلام.rar

تم تعديل بواسطه n_tareq
رابط هذا التعليق
شارك
سليم حاصبيا

سليم حاصبيا

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

لم افهم ماذا يعني حرف S في السطر التالي 

 If TextBox1.Text = Mid(ws1.Cells(S, 3).Text, 1, Len(TextBox1.Text))

اذا كنت تقصد الخلية S3 الخلية S3 فهي فارغة  بالصفحتين 

اوضح اكثر ماذا تريد بالضبط حتى تلقى المساعدة

هل تريد البحث عن اسم معين  واظهار بياناته ام رقم معين واظهار بياناته

اكسل يستطيع ذلك دون وجود اليوزر فورم الاول ولا الثاني

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

طارق نادر

قام بنشر
  • الكاتب
قام بنشر

 

اخي الكريم اريد البحث اما بواسطة الاسم او الرقم الوزاري كما هو في الفورم 

وبالنسبة لاستفسارك عن s3  هذا تعديل من قبل الاستاذ الفاضل حمادة عمر وسارفق شرحه كما هو (

وبالتالي ستقوم بعمل حلقة تكرارية .. لكل منهما  .. لتكن مثلا S مثل T ولكن مع  LastRow1  ..

ثم يظل الجزء الاول في الكود والخاص بتفعيل عمل المطلوب في حالة اختيار   OptionButton1  كما هو بدون تعديل

ثم يتم تغيير الجزء الخاص بتفعيل عمل المطلوب من الكود في حالة اختيار OptionButton2 كالتالي 

If OptionButton2.Value = True Then
        If TextBox1.Text = Mid(ws1.Cells(S, 3).Text, 1, Len(TextBox1.Text)) Then
        UserForm1.ComboBox1.AddItem ws1.Cells(S, 3)
        UserForm1.Controls("TextBox" & i).Value = ws1.Cells(S, i).Value
        UserForm1.CommandButton4.Enabled = True
        Unload Me
        End If
رابط هذا التعليق
شارك
سليم حاصبيا

سليم حاصبيا

قام بنشر
قام بنشر
4 دقائق مضت, n_tareq said:

 

اخي الكريم اريد البحث اما بواسطة الاسم او الرقم الوزاري كما هو في الفورم 

لم تجب على السؤال حول حرف S في الكود(ذلك مهم جداً لمعرفة ما تريد)

رابط هذا التعليق
شارك
طارق نادر

طارق نادر

قام بنشر
  • الكاتب
قام بنشر

اخي الكريم حرف s من تعديل الاستاذ حماده عمر ولا اعلم بالضبط تفسيره كتبته كما قال لي ارجو ان يتسع صدرك لي وشكرا

اظن انها حلقة تكرارية كما فهمت

اخي الفاضل سليم حاصبيا سارفق لك تعديل الاستاذ حمادة عمر لكي تتوضح لك معلومة والاجابة عن استفسارك حول حرف s

السلام عليكم

الاخ الكريم /n_tareq

بارك الله فيك

بعد اذن اخي الحبيب / سليم حاصبيا .. جزاه الله خيرا

انت قمت فعلا بتنفيذ ما اخبرك به من تعديل اسماء الشيتات ولكنك تجاهلت اسم هذه الشيتات في باقي الكود

وبذلك تصبح التعديلات في الكود كما يلي :

** بدلا من السطر التالي للمتغيرات .. 

Dim i As Integer, LastR As Long, ws As Worksheet

سنضيف به المتغير الآخر وهو الورقة الثانية او الشيت الثاني كما هو في السطر التالي 

Dim i As Integer, LastR As Long, ws, ws1 As Worksheet

** السطرين التاليين 

Set ws = ThisWorkbook.Sheets("البيانات")
Set ws = ThisWorkbook.Sheets("المدراء")

سيتم تغييرهم تبعا للمتغيرات التي قمت بوضعهم في الجزئية السابقة كما يلي : 

Set ws = ThisWorkbook.Sheets("البيانات")
Set ws1 = ThisWorkbook.Sheets("المدراء")

** ثم جزئية آخر صف .. سيتم تغيير او اضافة للصف التالي 

LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1

كما هو يلي 

LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1
LastRow1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row + 1

وبالتالي ستقوم بعمل حلقة تكرارية .. لكل منهما  .. لتكن مثلا S مثل T ولكن مع  LastRow1  ..

ثم يظل الجزء الاول في الكود والخاص بتفعيل عمل المطلوب في حالة اختيار   OptionButton1  كما هو بدون تعديل

ثم يتم تغيير الجزء الخاص بتفعيل عمل المطلوب من الكود في حالة اختيار OptionButton2 كالتالي 

If OptionButton2.Value = True Then
        If TextBox1.Text = Mid(ws1.Cells(S, 3).Text, 1, Len(TextBox1.Text)) Then
        UserForm1.ComboBox1.AddItem ws1.Cells(S, 3)
        UserForm1.Controls("TextBox" & i).Value = ws1.Cells(S, i).Value
        UserForm1.CommandButton4.Enabled = True
        Unload Me
        End If
رابط هذا التعليق
شارك
ابراهيم الحداد

ابراهيم الحداد

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

السلام عليكم ورحمة الله

محاولة لا اضمن لها النجاح

لأن العمل بدون الملف هو مضيعة للوقت

استبدل الكود السابق بنفس الكود مع تعديل تخيلى 

Private Sub CommandButton1_Click()
On Error Resume Next
Dim i As Integer, LastR As Long, ws, ws1 As Worksheet
Set ws = ThisWorkbook.Sheets("البيانات")
Set ws1 = ThisWorkbook.Sheets("المدراء")
LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1
LastRow1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row + 1
For i = 2 To 15
UserForm1.ComboBox1.Clear
For T = 2 To LastRow
For S = 2 To LastRow1
If OptionButton1.Value = True Then
    If TextBox1.Text = Mid(ws1.Cells(T, 3).Text, 1, Len(TextBox1.Text)) Then
        UserForm1.ComboBox1.AddItem ws1.Cells(T, 3)
        UserForm1.Controls("TextBox" & i).Value = ws1.Cells(T, i).Value
        UserForm1.CommandButton4.Enabled = True
        Unload Me
    End If
Else
If OptionButton2.Value = True Then
        If TextBox1.Text = Mid(ws.Cells(S, 3).Text, 1, Len(TextBox1.Text)) Then
        UserForm1.ComboBox1.AddItem ws.Cells(S, 3)
        UserForm1.Controls("TextBox" & i).Value = ws.Cells(S, i).Value
        UserForm1.CommandButton4.Enabled = True
        Unload Me
        End If
End If
End If
Next
Next
Next
UserForm1.ComboBox1.ListIndex = 0
If UserForm1.TextBox2.Text = "" Then MsgBox "??C C???U? U?? ????I", vbInformation + vbMsgBoxRight, "?E??E C?E?E"
UserForm1.CommandButton3.Enabled = False
End Sub

 

تم تعديل بواسطه زيزو العجوز
  • Like 1
رابط هذا التعليق
شارك
حمادة عمر

حمادة عمر

قام بنشر
قام بنشر

شاهد المرفق اخي الكريم

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

ولكنه اسرع من الكود خاصتك .. وان شاء الله ان كان يفي بغرضك نكمل ..

تقبل خالص تحياتي

 

20171صيفية برمجية استعلام.rar

  • Like 1
رابط هذا التعليق
شارك
طارق نادر

طارق نادر

قام بنشر
  • الكاتب
قام بنشر

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

رابط هذا التعليق
شارك
طارق نادر

طارق نادر

قام بنشر
  • الكاتب
قام بنشر
في ٢٣‏/٤‏/٢٠١٧ at 15:02, زيزو العجوز said:

السلام عليكم ورحمة الله

محاولة لا اضمن لها النجاح

لأن العمل بدون الملف هو مضيعة للوقت

استبدل الكود السابق بنفس الكود مع تعديل تخيلى

ارفق لك الملف اخي الكريم 


Private Sub CommandButton1_Click()
On Error Resume Next
Dim i As Integer, LastR As Long, ws, ws1 As Worksheet
Set ws = ThisWorkbook.Sheets("البيانات")
Set ws1 = ThisWorkbook.Sheets("المدراء")
LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1
LastRow1 = ws1.Cells(Rows.Count, "B").End(xlUp).Row + 1
For i = 2 To 15
UserForm1.ComboBox1.Clear
For T = 2 To LastRow
For S = 2 To LastRow1
If OptionButton1.Value = True Then
    If TextBox1.Text = Mid(ws1.Cells(T, 3).Text, 1, Len(TextBox1.Text)) Then
        UserForm1.ComboBox1.AddItem ws1.Cells(T, 3)
        UserForm1.Controls("TextBox" & i).Value = ws1.Cells(T, i).Value
        UserForm1.CommandButton4.Enabled = True
        Unload Me
    End If
Else
If OptionButton2.Value = True Then
        If TextBox1.Text = Mid(ws.Cells(S, 3).Text, 1, Len(TextBox1.Text)) Then
        UserForm1.ComboBox1.AddItem ws.Cells(S, 3)
        UserForm1.Controls("TextBox" & i).Value = ws.Cells(S, i).Value
        UserForm1.CommandButton4.Enabled = True
        Unload Me
        End If
End If
End If
Next
Next
Next
UserForm1.ComboBox1.ListIndex = 0
If UserForm1.TextBox2.Text = "" Then MsgBox "??C C???U? U?? ????I", vbInformation + vbMsgBoxRight, "?E??E C?E?E"
UserForm1.CommandButton3.Enabled = False
End Sub

 

 

2017صيفية برمجية 2استعلام.rar

رابط هذا التعليق
شارك
طارق نادر

طارق نادر

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

اخي زيزو العجوز بعد تعديلك الكريم فقد اكتشفت ان هذا الامر الذي ينفذ نعديل البيانات لا يعمل سارفق لك الكود 

  

Private Sub CommandButton4_Click()
Dim ws As Worksheet, LastRow As Long
Set ws = ThisWorkbook.Sheets("ÇáÈíÇäÇÊ")

LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row + 1
    
If Me.ComboBox1.Text <> "" Then
  For T = 2 To LastRow
    If Me.ComboBox1.Text = ws.Cells(T, 3) Then
    ws.Cells(T, 2).Resize(1, 14).Interior.Color = vbCyan

      For i = 2 To 17
       ws.Cells(T, i).Value = Me.Controls("TextBox" & i).Value
      Next
      MsgBox "Êã ÊÚÏíá ÈíÇäÇÊ ÇáãæÙÝ ÈäÌÇÍ", vbOKOnly + vbInformation, "Êã ÇáÊÚÏíá"
      GoTo 1
    End If
  Next
End If
1
For i = 2 To 17
 Me.Controls("TextBox" & i).Value = ""
 Next
CommandButton3.Enabled = False
CommandButton4.Enabled = False

Me.ComboBox1.Clear
TextBox2.SetFocus
End Sub

 

تم تعديل بواسطه n_tareq
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept