اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

قام بنشر

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

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

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

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

قام بنشر

أخى عبد الله

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

أخى abouelhssan شكرا لك

انسخ زر الأمر

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

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

شاهد المرفق

وجرب بنفسك

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

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

قام بنشر

أخى الكريم

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

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

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

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

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

هذا ملفك

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

قام بنشر

استاذ كيماس

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

سنجده

37152

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

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

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

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

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

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

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

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

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

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

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

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

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

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

وهكذا

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

وفق الله

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

فى هذه الحالة

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

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

هذا الملف

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

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

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

قام بنشر

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

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

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

بدعة حقيقية

وفقك الله

ياسر الحافظ

قام بنشر

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

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

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

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

في الاكواد

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

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

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

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

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

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

رمز الدخول 123

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

وربنا يوفقك

delet.rar

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

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

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

تم تعديل بواسطه 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

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