رجب جاويش

الأخت الفاضلة / الفصول الأربعة جزاك الله كل خير

أخى الفاضل / محمد جزاك الله كل خير

الأخت الفاضلة / الفصول الأربعة شكرا جزيلا أختى الفاضلة وجزاك الله كل خير بالنسبة لطلبك الأول يتم استبدال السطر x = Rng.Cells.Find(Val(Me.TextBox1.Value)).Activate بالسطر التالى x = Rng.Cells.Find(Me.TextBox1.Value, LookAt:=xlWhole, MatchCase:=True).Activate أما بالنسبة للطلب الثانى الخاص بالبحث عن الأسماء يكون الكود كالآتى Private Sub CommandButton1_Click() Set Rng = ActiveSheet.Range("A6:A10000") On Error Resume Next x = Rng.Cells.Find(Me.TextBox1.Value, LookAt:=xlWhole, MatchCase:=True).Activate Unload Me If x = Empty Then MsgBox "الأسم الذى تبحث عنه غير موجود", vbOKOnly, "اسم غير موجود" End Sub

أخى الحبيب / عباس الساوي تشرفت جدا أخى الحبيب بمرورك العطر وكلماتك الطيبة فجزاك الله كل خير

أختى الفاضلة / سما محمد الحمد لله أن وفقنى ربى لإكمال العمل كما تريدين وجزاك الله كل خير على هذه الكلمات الطيبة العطرة

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

الأخت الفاضلة / سما محمد استبدلى الكود السابق بالكود التالى Private Sub CommandButton1_Click() Set Rng = ActiveSheet.Range("A6:A10000") On Error Resume Next x = Rng.Cells.Find(Val(Me.TextBox1.Value)).Activate Unload Me If x = Empty Then MsgBox "الرقم الذى تبحث عنه غير موجود", vbOKOnly, "رقم غير موجود" End Sub

وهذا كود آخر Private Sub CommandButton1_Click() On Error Resume Next Cells(Range("A6:A214").Find(Val(Me.TextBox1)).Row, 1).Select Unload Me End Sub كود للبحث عن رقم1.rar

تفضل أختى الفاضلة Private Sub CommandButton1_Click() Set Rng = Sheets("Sheet1").Range("A6:A214") For Each cl In Rng If Val(Me.TextBox1.Value) = Val(cl) Then Cells(cl.Row, 1).Select Unload Me End If Next End Sub كود للبحث عن رقم.rar

ولاثراء الموضوع هذا حل بالأكواد Sub ragab() Dim sh As Worksheet Dim ws As Worksheet Dim LR1 As Integer, LR2 As Integer Dim cl As Range, cll As Range '============================================= Set sh = Sheets("sheet1") Set ws = Sheets("sheet2") LR1 = sh.Cells(Rows.Count, 1).End(xlUp).Row LR2 = ws.Cells(Rows.Count, 1).End(xlUp).Row '============================================= For Each cl In sh.Range("A2:A" & LR1) For Each cll In ws.Range("A2:A" & LR2) If Val(cl) = Val(cll) Then cll.Offset(0, 2) = cl.Offset(0, 2) End If Next Next Set sh = Nothing Set ws = Nothing End Sub link.rar

أخى الفاضل محمد السطر التالى غير الحرف الخاص بالعمود A الى الى عمود آخر تريده LR = [A1000].End(xlUp).Row السطر التالى IIf Target.Column <> 1 Or Target = "" Then Exit Sub غير الرقم 1 الى رقم العمود الذى تريده فى السطرين التالىين For Each cl In Range("A2:A" & LR) For Each cll In Range("A2:A" & LR - 1) غير الحرف الخاص بالعمود A الى الى عمود آخر تريده السطر التالى If Application.WorksheetFunction.CountIf(Range(Cells(cl.Row, 1), Cells(LR, 1)), cl) > 1 Then غير الرقم 1 فى الجزء Cells(cl.Row, 1), Cells(LR, 1)) الى رقم العمود الذى تريده

أخى الفاضل ليست صعوبة الموضوع ولكن لعدم وجود مرفق للعمل عليه برجاء ارسال ملف مرفق به مثال وشرح لما تريد

أخى الحبيب / حمادة عمر شكرا جزيلا أخى الحبيب على كلماتك الرقيقة ومرورك العطر

أخى الفاضل / محمد هذا هو الكود المستخدم وهو يوضع فى حدث الورقة Private Sub Worksheet_Change(ByVal Target As Range) Dim LR As Integer, cl As Range, cll As Range LR = [A1000].End(xlUp).Row '========================================================== If Target.Count > 1 Then Exit Sub If Target.Column <> 1 Or Target = "" Then Exit Sub For Each cl In Range("A2:A" & LR) If Application.WorksheetFunction.CountIf(Range(Cells(cl.Row, 1), Cells(LR, 1)), cl) > 1 Then For Each cll In Range("A2:A" & LR - 1) If Target = cll Then arr = arr & cll.Address & "," End If Next m = MsgBox("هذا الاسم مكرر فى الخلية" & Chr(10) & arr & Chr(10) & "هل تريد السماح بتكرار هذا الاسم", vbYesNo, "اسم مكرر") If m = vbYes Then Exit Sub Target = "": Target.Select: Exit Sub End If Next End Sub

أخى الفاضل / محمد بعد أفضل تحية بالنسبة للطلب الاول جرب الملف المرفق أما بخصوص ثانيا فإن التعديل الذى قمت أنت بعملة صحيح وجميل جدا تسلم ايديك ويؤكد ما قلته أنا سابقا أن المنتدى سوف يكسب عضو متميز فى القريب العاجل منع تكرار الاسم (2).rar

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

أختى الفاضلة / الفصول الأربعة شكرا جزيلا أختى الفاضلة على هذه الكلمات الطيبة وجزاك الله كل خير

يوجد أيضا ثلاث اجابات على نفس السؤال فى الرابط التالى http://www.officena.net/ib/index.php?showtopic=47562

أخى الفاضل / شوقى ربيع شكرا جزيلا أخى الفاضل على هذه الكلمات الطيبة وجزاك الله كل خير

أخى الفاضل / عادل تفضل ما تريد Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$C$18" Then LR = [A1000].End(xlUp).Row For i = 2 To LR If Cells(i, 1) <> "" And Cells(i, 1) < Target Then Range("D18") = Format(Cells(i, 1), "yyyy/mm/dd") Next For ii = LR To 2 Step -1 If Cells(ii, 1) <> "" And Cells(ii, 1) > Target Then Range("E18") = Format(Cells(ii, 1), "yyyy/mm/dd") Next End If End Sub هذا الكود فى حدث الورقة يشترط أن تكون التواريخ مرتبة تصاعديا التاريخ المحصوروتحديدبداية الفنرة ونهايتها.rar

أستاذى الحبيب / عبد الله باقشير تسلم ايديك دائما أكوادك لها طابع خاص

أخى الحبيب / حمادة عمر شكرا جزيلا أخى الحبيب على هذه الكلمات الطيبة وجزاك الله كل خير

أخى الفاضل / ابراهيم جزاك الله كل خير

أخى ابراهيم جرب الكود التالى Sub ragab() x = ActiveCell.Value cel = Application.InputBox("قيمة الخلية النشطة هى", "الخلية النشطة", x) End Sub

شكرا جزيلا أخى الفاضل وجزاك الله كل خير