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

[اوفيس 2003]

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

لدي حوالي اكثر من 100 الف كود قديم وسوف يتم تغير هذا التكويد الى كود جديد تماماً لتوسعة الشركة التي اعمل بها

المهم ارفقت ملف بسيط اوضح لما اريد ، وطبعاً لا اريده بالضبط كما ارفقت لو هناك عرض افضل او رؤية احلى واجمل يكون افضل بكثير ولكن انا ارفقت الملف لتعليمي كيف اضع الأكواد الله يبارك فيكم

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

هو سرد تفاصيل هذا الكود بالكامل الله يبارك فيكم

في انتظار اجابتكم الله يبارك فيكم ، واتمنى شرح مفصل لي للدوال ، وكيفية حماية الملف من العبث واللعب بالأكواد

Q.rar

[الـعيدروس]

السلام عليكمحط هذه الاكواد في حدث ورقة R

Option ExplicitPrivate Const SH As String = "DATA"Private Const CO_T As Integer = 1Private Const CO_T1 As Integer = 2Dim RODim Var As BooleanPrivate Sub CommandButton1_Click()SSALIDROOS ' لتفعيل الكود' تخصيص زر ActivateEnd SubPrivate Sub R_SeT(M_R As String)With Application.ScreenUpdating = False.EnableEvents = FalseDim QQ%, CC%, C%Dim RR As RangeDim L_C&, SS&QQ = 16C = 1With Sheets(SH)L_C = .Cells(.Rows.Count, IIf(Var, CO_T, CO_T1)).End(xlUp).RowFor SS = 1 To L_C For CC = 2 To 17 If CStr(.Cells(SS, IIf(Var, CO_T, CO_T1))) = M_R Then Cells(CC + 14, "G").Value = .Cells(SS, CC + 2).Value Cells(9, "I") = .Cells(SS, 1).Value Cells(5, "I") = .Cells(SS, 2).Value End If C = C + 1 Next QQ = QQ + 1NextEnd With.ScreenUpdating = True.EnableEvents = TrueEnd WithEnd SubPrivate Sub ALIDROOS()Dim A As RangeDim B As RangeSet A = [D5]: Set B = [D9]If A <> Empty And B <> Empty ThenMsgBox "حدد معيار للبحث فقط", vbCritical, "تنبية !!!"ElseIf A > Empty And Not B <> Empty ThenRO = A.RowVar = TrueR_SeT A.TextElseIf B > Empty And Not A <> Empty ThenRO = B.RowVar = FalseR_SeT B.TextEnd IfEnd SubPrivate Sub SS()Select Case Var Case Is = TrueUnion(Cells(RO, 9), Cells(RO, 9).Offset(4, 0), Cells(RO, 7).Offset(11, 0).Resize(14, 1)).ClearContents Case Is = FalseUnion(Cells(RO, 9), Cells(RO, 9).Offset(-4, 0), Cells(RO, 7).Offset(7, 0).Resize(14, 1)).ClearContentsEnd SelectEnd Sub

تم ارفاق الملف وبه الاكواد

Q_Ali_1.rar

تم تعديل سبتمبر 16, 2012 بواسطه عباد

[اوفيس 2003]

مشكور ياغالي ، الله يبارك فيك

ولكن اريد ياغالي دوال بمجرد ان اكتب الكود القديم او الجديد واضغط انتر يظهر على طول الكود الأخر والبيانات في الأسفـل ،

[الـعيدروس]

جرب المرفق بنفس المشاركه السابقة

بمجرد الكتابه يظهر البيانات

[اوفيس 2003]

جربت ياغالي والله ، وانت مسوي زر اضغط هنا للبحث وعند اختياره تأتي لي رسالة الخطأ المعروفة لعدم تعرف على الكود المبرمج

ياريت زي ا انا مسوي اكتب الرقم يظهر لي الأخر مع العكس ومع اظهار باقي البيانات ولو امكن عمل قائمة بعيدة عن الإكسل بحيث تفتح لي وعبارة عن مااريد

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

جزاك الله كل خير اخي الحبيب

تم تعديل سبتمبر 16, 2012 بواسطه office 2003

[الـعيدروس]

قم بتحميل المرفق مره اخرى

[اوفيس 2003]

جميل ورائع اخي عباد اكثر من رائع

طيب لو قمت بتغير الخلايا الى اماكن اخرى هل ممكن استخدم دوال بدلاً من الكود ياغالي

وهل ممكن عمل قائمة بدل من الدخول الى الملف من الخارج مثل البرامج

[اوفيس 2003]

منتظر الرد والأجابة الله يبارك فيكم

[الـعيدروس]

السلام عليكم

جرب المرفق

هذا مقتبس من أعمال الاستاذ الكبير عبدالله باقشير حفظه الله

User_Ali.rar

User_Ali_1.rar

تم تعديل سبتمبر 19, 2012 بواسطه عباد

[أبو ردينة]

بارك الله بك أخي و أستاذي / أبو نصار و نفع بعلمك

[saad abed]

استاذى ابو نصار

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

بارك الله فيك

نتعلم منك الكثير

سعد عابد

[الـعيدروس]

السلام عليكم

الاخوة الاحبه سعد عابد وأبو ردينه

جزاكم الله خير على الكلمات الطيبه والمرور العطر

الفضل يعود للأستاذ الحبيب خبور خير

[عبدالله باقشير]

السلام عليكم

اخي الحبيب عباد حفظك ربي

عمل جميل

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

[عبدالله باقشير]

السلام عليكم

بالمعادلات

المرفق 2003

Q.rar

[الـعيدروس]

وعليكم السلام

سلمت استاذ عبدالله على المرور العطر

وجزاك الله خير على اعمالك المتقنه

تلميذك أبو نصار