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

**abouelhassan** · ديسمبر 23, 2011

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

هذا الكود للاستاذ كيماس

به امكانية البحث عن كلمة وحذف السطر الذى يحتوى على هذه الكلمة فى كل الشيت

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

المطلوب التعديل

ليقوم بالاتى

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

وذلك لكل الصفحات

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

**عبدالله المجرب** · ديسمبر 23, 2011

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

**abouelhassan** · ديسمبر 23, 2011

استاذنا اشرقت الانوار

الملف اكسيل

ويعمل عندى على اكسيل 2003

وهذا رابط الموضوع بالمشاركة 7

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

احترام شديد من كل قلبى

تم تعديل ديسمبر 23, 2011 بواسطه abouelhssan

**abouelhassan** · ديسمبر 24, 2011

للرفع

رفع الله قدركم

**abouelhassan** · ديسمبر 25, 2011

للرفع

رفع الله قدركم

**abouelhassan** · ديسمبر 25, 2011

للرفع

رفع الله قدركم

**الـعيدروس** · ديسمبر 25, 2011

السلام عليكم

جرب هذا الكود


Const T_A = "منتدى أوفسينا "

Const M_A = "قم بإدخال القيمة المراد حذف الصفوف من كافة الأوراق"

Sub ALIDROOS_DE_ALL()

    Dim S As Worksheet

    Dim i As Long

    Dim ALI_T As Variant

    Dim Q As String

    Dim ALI_F As Range

    ALI_T = InputBox(prompt:=M_A, Title:=T_A)

    If MsgBox("سيتم حذف جميع الكلمات المطابقة من كل الأوراق", vbOKCancel, "تحذير !!!") = vbOK Then

    If ALI_T = "" Then Exit Sub

    Application.ScreenUpdating = False

    For Each S In ThisWorkbook.Worksheets

    For i = S.Cells.SpecialCells(xlCellTypeLastCell).Row To 1 Step -1

	 Set ALI_F = S.Rows(i).Find(what:=ALI_T, LookIn:=xlValues, lookat:=xlWhole)

	  If Not ALI_F Is Nothing Then S.Rows(i).Delete

    Next

    Next

    Q = ALI_T

    MsgBox Q & vbNewLine & "^====" & " تم حذف الصفوف التي وجد فيها هذه الكلمة من كافة الأوراق " & "بنجاح"

    Else

    MsgBox "تم إلغاء العملية"

    Exit Sub

    End If

    Application.ScreenUpdating = True

End Sub

**abouelhassan** · ديسمبر 26, 2011

الله الله الله استاذنا ابو نصار اطال الله عمرك

هذا هو استاذنا والله الله يبارك لك

والله مجرد ما اقرأ اسمك اعرف ان الاجابة الشافية اتت

كل وفائق الاحترام والتقدير والدعاء من اخيك

**abouelhassan** · ديسمبر 26, 2011

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

ممكن ان الكود بعد اليحث والايجاد

يخيرنى هل تريد الحذف yاوN

فى حالة نعم يحذف وينتقل للسطر التالى ثم الصفحة التالية

وكذلك الحال فى n يتم الانتقال للسطر التالى ثم الصفحة التالية

فهمنى استاذنا

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

**abouelhassan** · ديسمبر 27, 2011

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

ممكن ان الكود بعد اليحث والايجاد

يخيرنى هل تريد الحذف yاوN

فى حالة نعم يحذف وينتقل للسطر التالى ثم الصفحة التالية

وكذلك الحال فى n يتم الانتقال للسطر التالى ثم الصفحة التالية

فهمنى استاذنا

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

للرفع رفع الله قدركم

**عبدالله باقشير** · ديسمبر 27, 2011

السلام عليكم

ده كود لي قديم للبحث في الاوراق

ينفع ده للتعديل عليه لحذف الصف ؟؟؟




Option Explicit


Sub Kh_Find_All()

Dim MyTextFind As Variant

Dim MySh As Worksheet

Dim C As Range

Dim FirstAddress As String


MyTextFind = Application.InputBox("اكتب ما تريد البحث عنه ؟", "بحث في جميع الاوراق الظاهرة")

If MyTextFind = "" Or MyTextFind = False Then Exit Sub


For Each MySh In ActiveWorkbook.Worksheets

    If MySh.Visible = xlSheetVisible Then

        With MySh.Cells

            Set C = .Find(MyTextFind, LookIn:=xlValues)

            If Not C Is Nothing Then

                FirstAddress = C.Address

                Do

                    MySh.Activate

                    C.Select

                    If MsgBox("تم ايجاد قيمة البحث في العنوان" & Chr(10) & Chr(10) & MySh.Name & "!" & C.Address _

                    & Chr(10) & Chr(10) & "هل تريد الاستمرار في البحث ؟", 524288 + 1048576 + 4, "تاكيد") = 7 Then GoTo 1

                    Set C = .FindNext(C)

                Loop While Not C Is Nothing And C.Address <> FirstAddress

            End If

        End With

    End If

Next MySh


MsgBox IIf(Len(FirstAddress), "انتهى البحث", "لا توجد نتائج للبحث "), 524288 + 1048576, "بحث"

1:

Set C = Nothing

End Sub

اذا يناسبك سنقوم بذلك

**الـعيدروس** · ديسمبر 27, 2011

جرب هذا الكود

هو للورقة النشطة

لاني عكيت على كافة الاوراق

مازبطت معي دالة التكرار

لي محاولة اخرى ان شاء الله


Private Sub CommandButton1_Click()

Dim ALI_D As Range, ALI_R As Range

Dim go  As String

GO1 = InputBox("إدخل الكلمة المراد حذف الصفوف", "منتدى أوفسينا")

If GO1 = "False" Or GO1 = vbNullString Then Exit Sub

On Error Resume Next

If vbYes Then

Set ALI_D = ActiveSheet.Range("B2:B500")

For Each ALI_R In ALI_D.Rows

If Not ALI_R.Find(what:=GO1, LookIn:=xlValues, lookat:=xlWhole) Is Nothing Then

ALI_R.Select

If MsgBox("هل تريد حذف هذه النتيجة", vbOKCancel, "تحذير !!!") = vbOK Then

ActiveCell.EntireRow.Delete

End If

End If

Next ALI_R

End If

End Sub

تم تعديل ديسمبر 27, 2011 بواسطه alidroos

**الـعيدروس** · ديسمبر 27, 2011

استاذ خبور خير جميل جدا

كود محترف من شخص محترف

بارك الله فيك

**عبدالله باقشير** · ديسمبر 27, 2011

السلام عليكم

حبيبي ابو انصار ,,,, بوركت

هذا التعديل على الكود ليقوم بالحذف




Option Explicit


Sub Kh_Find_All()

Dim MyTextFind As Variant

Dim MySh As Worksheet

Dim C As Range, CC As Range

Dim FirstAddress As String


MyTextFind = Application.InputBox("اكتب ما تريد البحث عنه ؟", "بحث في جميع الاوراق الظاهرة")

If MyTextFind = "" Or MyTextFind = False Then Exit Sub


For Each MySh In ActiveWorkbook.Worksheets

	If MySh.Visible = xlSheetVisible Then

		With MySh.Cells

			Set C = .Find(MyTextFind, LookIn:=xlValues)

			If Not C Is Nothing Then

				FirstAddress = C.Address

				Do

					MySh.Activate

					C.Select

					'-------------------------

					If MsgBox("تم ايجاد قيمة البحث في العنوان" & Chr(10) & Chr(10) & MySh.Name & "!" & C.Address _

						& Chr(10) & Chr(10) & "هل تريد حذف الصف   ؟", 524288 + 1048576 + 4, "تاكيد") = 6 Then

						If CC Is Nothing Then Set CC = C Else Set CC = Union(CC, C)

					End If

					'-------------------------

					If MsgBox("هل تريد الاستمرار في البحث ؟", 524288 + 1048576 + 4, "تاكيد") = 7 Then GoTo 1

					Set C = .FindNext(C)

				Loop While Not C Is Nothing And C.Address <> FirstAddress

			End If

		End With

	End If

	'-----------------------------------------

	If Not CC Is Nothing Then CC.EntireRow.Delete: Set CC = Nothing

	'-----------------------------------------

Next MySh


MsgBox IIf(Len(FirstAddress), "انتهى البحث", "لا توجد نتائج للبحث "), 524288 + 1048576, "بحث"

1:

Set C = Nothing

End Sub

بحث بجميع الاوراق مع حذف نتيجة البحث.rar

**عبدالله المجرب** · ديسمبر 27, 2011

السلام عليكم

ما دام ابو علي افتى في المساءلة

فابشر اخي ابوالحسن فقد منيت بدرة من دررة ذات الجودة العالية

====

حفظك الله ابوعلي وجزاك كل خير على ما تقدمه

**الـعيدروس** · ديسمبر 27, 2011

السلام عليكم

جربت الكود حقيقة من شدة اعجابي بهذ العمل

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

كود قمة في الروعة خلينا نشوفك على طول

حلولك فريده من نوعها

تقبل مروري

**abouelhassan** · ديسمبر 27, 2011

استاذنا خبور خير الله يرضى عنك استاذنا

اتمنى من الله لك كل الخير والله

بس مطلوب تعديل

استاذنا

احتاج عندما يجد القيمة واختار نعم للحذف يحذفه دون الانتظار لنهاية البحث

لانى عندما اختار عدم الاستمرار بالبحث لا يحذف ما سبق اختياره للبحث

**abouelhassan** · ديسمبر 27, 2011

مرور كريم ااستاذنا الكريم

عبدالله المجرب(ابواحمد)

**عبدالله باقشير** · ديسمبر 27, 2011

السلام عليكم

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

تم التعديل سريعا

ساعدل الجزئية هذه

**abouelhassan** · ديسمبر 27, 2011

الله يعزك ويبارك لك

استاذنا

الخلوق شديد الكرم

اعزك الله امين

**عبدالله باقشير** · ديسمبر 27, 2011

اضف هذا السطر آخر الكود

If Not CC Is Nothing Then CC.EntireRow.Delete: Set CC = Nothing

وسيعمل حسب طلبك

الى ان اعدله بروية

**abouelhassan** · ديسمبر 27, 2011

استاذنا

سأنتظر حضرتك لانه لم يعمل مع

سامحنى استاذنا

احترامى

**عبدالله باقشير** · ديسمبر 27, 2011

السلام عليكم

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

ثم يقوم بالحذف من الانتهاء منها

وهكذا مع الاخرى

في حالة الخروج من الرسالة

يتفحص نطاق التجميع ان وجده موجود يقوم بالحذف

**عبدالله باقشير** · ديسمبر 27, 2011


Option Explicit


Sub Kh_Find_All()

Dim MyTextFind As Variant

Dim MySh As Worksheet

Dim C As Range, CC As Range

Dim FirstAddress As String


MyTextFind = Application.InputBox("اكتب ما تريد البحث عنه ؟", "بحث في جميع الاوراق الظاهرة")

If MyTextFind = "" Or MyTextFind = False Then Exit Sub


For Each MySh In ActiveWorkbook.Worksheets

    If MySh.Visible = xlSheetVisible Then

        With MySh.Cells

            Set C = .Find(MyTextFind, LookIn:=xlValues)

            If Not C Is Nothing Then

                FirstAddress = C.Address

                Do

                    MySh.Activate

                    C.Select

                    '-------------------------

                    If MsgBox("تم ايجاد قيمة البحث في العنوان" & Chr(10) & Chr(10) & MySh.Name & "!" & C.Address _

                        & Chr(10) & Chr(10) & "هل تريد حذف الصف   ؟", 524288 + 1048576 + 4, "تاكيد") = 6 Then

                        If CC Is Nothing Then Set CC = C Else Set CC = Union(CC, C)

                    End If

                    '-------------------------

                    If MsgBox("هل تريد الاستمرار في البحث ؟", 524288 + 1048576 + 4, "تاكيد") = 7 Then GoTo 1

                    Set C = .FindNext(C)

                Loop While Not C Is Nothing And C.Address <> FirstAddress

            End If

        End With

    End If

    '-----------------------------------------

    If Not CC Is Nothing Then CC.EntireRow.Delete: Set CC = Nothing

    '-----------------------------------------

Next MySh


MsgBox IIf(Len(FirstAddress), "انتهى البحث", "لا توجد نتائج للبحث "), 524288 + 1048576, "بحث"

1:

If Not CC Is Nothing Then CC.EntireRow.Delete: Set CC = Nothing

Set C = Nothing

End Sub

**abouelhassan** · ديسمبر 27, 2011

استاذنا استأذنك

الكود ماشاء الله تمام جدااا

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

ممكن استاذنا

الله يحفظك

تسجيل الدخول

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

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

abouelhassan

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

abouelhassan

abouelhassan

abouelhassan

abouelhassan

الـعيدروس

abouelhassan

abouelhassan

abouelhassan

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

الـعيدروس

الـعيدروس

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

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

الـعيدروس

abouelhassan

abouelhassan

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

abouelhassan

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

abouelhassan

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

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

abouelhassan

Join the conversation

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

تصفح الموقع

تصفح جديد الموقع

Support

Important Information