مساعدة فى البحث بملف الاكسيل

[abouelhassan]

الاخوة الاساتذة الافاضل

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

اليا يسأل هل تريد حذف الصف كله الذى به الخلية المطابقة للبحث

1.rar

[عبد الفتاح كيرة]

تفضل

Range("a1").Select

Dim mySearch As Variant

mySearch = InputBox("ÇßÊÈ ãÇ ÊÑíÏ ÇáÈÍË Úäå ")

'

On Error GoTo 1

    Cells.Find(What:=mySearch, After:=ActiveCell, LookIn:=xlFormulas, LookAt _

        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _

        False, SearchFormat:=False).Activate


        If MsgBox("åá ÊÑíÏ ÍÐÝ ÇáÕÝ ÇáãæÌæÏ Èå ÇáßáãÉ ¿", vbYesNo, "ÊÃßíÏ ÍÐÝ") = vbYes Then

        ActiveCell.EntireRow.Delete

        Else

        Exit Sub

        End If

1         End Sub

كود البحث عن كلمة فى الصفحة ثم حذف صفها.rar

[عبدالله المجرب]

عمل جميل يا ابا عمر

ابو احمد

[abouelhassan]

الله يبارك لك ويزيدك من فضله ونعمه

رجاء كيف يمكن ان اضيفه الى شيت اكسيل اخر

ارك الله فيك

احترامى الشديد

اخيك

[عبد الفتاح كيرة]

أخى عبد الله

شكرا لزيارتك بارك الله فيك

أخى abouelhssan شكرا لك

انسخ زر الأمر

والصقه فى أى شيت تريد

سيتم نسخه مع الكود

شاهد المرفق

وجرب بنفسك

أما إن كنت تقصد البحث فى كل الملف فينبغى تغيير الكود

كود البحث عن كلمة فى الصفحة ثم حذف صفهاورقتان.rar

[abouelhassan]

الله يبارك فيك وينعم عليك

نعم اخى فى كامل الملف رجاء

احترامى الشديد لشخصك الكريم

[عبد الفتاح كيرة]

أخى الكريم

هذا كود ممتاز جدا

و هو مخصص للبحث عن كلمة بكل الشيتات

تم التعديل فيه

لإضافة إمكانية حذف الصف

أنصح بأن يكون موجودا لدى كل الأعضاء

هذا ملفك

بحث بكل الشيتات- مع إمكانية حذف الصف.rar

[خالد الشاعر]

استاذ كيماس

عمل ممتاز تسلم ايدك

ولى طلب بعد اذنك فى موضوع خاص بالبحث ايضاَ

فى هذا الرابط خاص بالاستاذ القدير خبور

http://www.officena.net/ib/index.php?showtopic=36877

فهل ممكن المساعدة الظاهر الاستاذ خبور لا يتواجد كثيراً هذه الايام

ولك جزيل الشكر والاحترام

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

[عبد الفتاح كيرة]

راجعت الموضوع وجدت أن الأستاذ خبور حاول كثيرا فى هذا الأمر

المشكلة ناتجة من أن خاصية البحث

مخصصة أصلا للنصوص

حتى لو بحثنا عن رقم

فإنها تبحث عنه كسلسلة نصية

سلسلة تبدأ من اليمين حرفا حرفا

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

بل يعرفه كرقممسلسل يبدأ من سنة 1900

فلو حولنا مثلا

18/9/2001 إلى رقم مسلسل

سنجده

37152

من هنا تبدأ المشكلات

و أنت لا تضمن هذا الملف أن يعمل معك

أو أن يعمل على كل الأجهزة

لذلك لا أحبذ التصميم على حل مشكلة كهذه

و فوق كل ذى علم عليم

و لعل أحد الإخوة يكون لديه حل شاف

تم تعديل يونيو 8, 2011 بواسطه kemas

[الـعيدروس]

الاستاذ القدير كيماس السلام عليكم

هل بالامكان اكمال الفكرة

قبل حذف الصف يقوم بنسخ الصف كامل

مع التنسيقات ونوع الخط واللون

الى صفحة اخرى وبعدها يقوم بالحذف

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

ولصق النتيجه تحت الاسم الاول بسطر

وهكذا

ارجو اكمال الفكرة

وفق الله

تم تعديل يونيو 8, 2011 بواسطه alidroos

[عبد الفتاح كيرة]

فى هذه الحالة

لا يتصورالبحث فى كل الشيتات مع اللصق

لأننا سندخل فى حلقة مفرغة

هذا الملف

يبحث بالشيت الأول

ثم ينقل للشيت الثانى

كود البحث عن كلمة فى الصفحة ثم حذف و لصق صفهاورقتان.rar

[ياسر الحافظ]

استــــــــــــــــــــــــــــــــــــــــــــــــــــــاذ ابو عمر " كيماس " المحترم :

هذه ليست اعمال ولا ردود رائعة فقط

هي مدرسة بل جامعة حقيقية

بدعة حقيقية

وفقك الله

ياسر الحافظ

[خالد الشاعر]

اشكرك استاذ كيماس على المساعدة

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

[الـعيدروس]

ماذا يسمونه

ابداع كلمة قديمة

درر وجواهر تفيدني في عملي

جزاك الله خير استاذنا القدير كيماس

[عبد الفتاح كيرة]

الله يبارك فيكم جميعا

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

و أعظم سعادتى أن أنفع أحدا أو أساعده فى عمله

[الـعيدروس]

اشكرك جدا على ترحيبك وحبك لمساعدة الاخرين

الله يزيدك من فضله

حاولت اركب الكود تبعك في الفورم لكي يقوم

بنفس العمل لم تفلح المحاوله وذلك لعدم خبرتي الكافيه

في الاكواد

ملفي عبارة عن فورم ادخال

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

دبل كليك على الاسم يقوم بااظهار صندوق لادخال التصريح التصريح هوا 1234

ومباشره يقوم بحذف الاسم من ورقة data

اذا امكن ولديك متسع من الوقت تقوم بالاضافه الكريمه تبعك على الفورم

اكون شاكر ومقدر لسموك

رمز الدخول 123

الورقة المراد لصق الاسم المحذوف فيها اسمها delet

وربنا يوفقك

delet.rar

[عبد الفتاح كيرة]

طيب يا أخ alidroos

أنا جربت ملفك و هو شغال تمام

ينفذ تماما ما قلته

وفعلا حذف الاسم

و بالبحث مرة أخرى لم يكن موجودا

ما المطلوب؟

[الـعيدروس]

المطلوب خاصية اللصق الى ورقة delet

تم تعديل يونيو 8, 2011 بواسطه alidroos

[عبد الفتاح كيرة]

أضفت سطرين للصق قبل الحذف

عليك التأكد من عمل الكود

delet-kemas.rar

[الـعيدروس]

جاري التجربه حفظك الله

[الـعيدروس]

الاستاذ القدير كيماس لايوجد اي اضافات

الملف زي ماهو ارجو التأكد من الملف

تم تعديل يونيو 8, 2011 بواسطه alidroos

[الـعيدروس]

على مااهتقد انك اضفت الخاصيه

في الفورم الخطاء

اللي هو userform4

والمعني userform1

في خاصية دبل كليك الليت يوكس هذه

Private Sub ListBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)

Dim DADA As String

Dim MYSH As Worksheet

Dim PASSWORD As Integer

On Error Resume Next

PASSWORD = InputBox("الرجاء ادخال الرقم المصرح لك به لاتمام العمليه", "إدخال تصريح لحذف موظف مع جميع بياناته")

If PASSWORD <> "1234" Then

MsgBox "غير مصرح لك باتمام العمليه"

Else

If OptionButton1.Value Then

If MsgBox(":لقد طلبت حذف البيانات التالية" & vbNewLine & "" & vbNewLine & "إسـم المـوظف:  " & TextBox2 _

& vbNewLine & "" & vbNewLine & "الـراتب:  " & TextBox3 & vbNewLine & "" & vbNewLine & "عـامل:  " & ComboBox1 & vbNewLine & "" & vbNewLine & "التصنيــف:  " & ComboBox2 & vbNewLine & "" & vbNewLine & "المهنـه:  " & ComboBox3 & vbNewLine & "" _

& vbNewLine & "فهل تود الإستمرار؟", vbYesNo + vbQuestion, "تأكيد الحذف") = vbYes Then

A = Application.WorksheetFunction.Match(ListBox2, RNG1, 0)

Application.ScreenUpdating = False

'Me.Hide

MsgBox " تم حذف السجل الخاص ب" & ListBox2 & " بنجاح", vbInformation, "تم الحذف"

Application.ScreenUpdating = False

DADA = ListBox2.List(ListBox2.ListIndex, 8)

Set MYSH = Sheets("data")

With MYSH

 .Application.Range(DADA).Rows.Select

 .Range(DADA).EntireRow.Delete

 MsgBox "تمت العمليه بنجاح", 0, "رسالة الالغاء"

 Application.ScreenUpdating = True

 UserForm1.Show

 End With

    Range("a4:a478").Formula = "=SUBTOTAL(103,$B$2:B3)" '======'دالة المسلسل التلقائي

    Range("am4:am478").Formula = "=SUM(i4:Al4)" '======'مجموع ايام الغياب

    Range("aw4:aw478").Formula = "=D4-AN4-AO4-AQ4+AR4-AX4" '==='الصافي النهائي

    Range("an4:an478").Formula = "=Am4*(d4/30)" '===='إجمالي الغياب

    Range("h4:h478").Formula = "=ColorFunction($g$1,i4:Al4,TRUE)" '==='جمع ايام الجزاءات

    Range("d4:d478").Formula = "=c4+at4" '==== '  جمع البدل + الراتب

    Range("d479").Formula = "=SUM(D4:D478)" '==== 'جمع الكل  للبدل والرتب

    Range("an479").Formula = "=SUM(an4:an478)" '==== ' الجمع الكل إجمالي الغياب

    Range("ao479").Formula = "=SUM(ao4:ao478)" '==== 'جمع الكل لحقل الخصم

    Range("aq479").Formula = "=SUM(aq4:aq478)" '==== 'جمع الكل لحقل السكن

    Range("at479").Formula = "=SUM(at4:at478)" '==== 'جمع الكل للبدل الرسيمه

    Range("aw479").Formula = "=SUM(aw4:aw478)" '==== 'جمع الكل للصافي النهائ

    Range("ay4:ay400").Formula = "=VLOOKUP(am4,تقدير,2,true)" '======'دالة التقييم

 End If

 End If

  End If

 ListBox2.Clear

TextBox47.Text = ""

TextBox47.SetFocus

1        End Sub

[عبد الفتاح كيرة]

إذن

جرب هذا

نسخة من delet-kemas233.rar

[الـعيدروس]

ساأوافيك حالا جاري التحميل

[الـعيدروس]

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

للاسف لم يقم بالحذف حتى

وماجلب غير التنسيقات فقط