اذهب الي المحتوي
أوفيسنا

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

abouelhassan

بواسطه abouelhassan
في منتدى الاكسيل Excel

 مشاركة

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

abouelhassan

abouelhassan

قام بنشر
قام بنشر

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

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

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

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

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

ليقوم بالاتى

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

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

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

رابط هذا التعليق
شارك
abouelhassan

abouelhassan

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

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

الملف اكسيل

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

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

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

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

تم تعديل بواسطه abouelhssan
رابط هذا التعليق
شارك
الـعيدروس

الـعيدروس

قام بنشر
قام بنشر

السلام عليكم

جرب هذا الكود


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

abouelhassan

قام بنشر
  • الكاتب
قام بنشر

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

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

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

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

رابط هذا التعليق
شارك
abouelhassan

abouelhassan

قام بنشر
  • الكاتب
قام بنشر

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

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

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

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

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

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

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

رابط هذا التعليق
شارك
abouelhassan

abouelhassan

قام بنشر
  • الكاتب
قام بنشر

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

رابط هذا التعليق
شارك
عبدالله باقشير

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

قام بنشر
قام بنشر

السلام عليكم

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

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




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

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

رابط هذا التعليق
شارك
الـعيدروس

الـعيدروس

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

جرب هذا الكود

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

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

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

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


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

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

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

قام بنشر
قام بنشر

السلام عليكم

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

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




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

رابط هذا التعليق
شارك
عبدالله المجرب

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

قام بنشر
قام بنشر

السلام عليكم

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

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

====

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

رابط هذا التعليق
شارك
الـعيدروس

الـعيدروس

قام بنشر
قام بنشر

السلام عليكم

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

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

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

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

تقبل مروري

رابط هذا التعليق
شارك
abouelhassan

abouelhassan

قام بنشر
  • الكاتب
قام بنشر

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

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

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

استاذنا

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

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

رابط هذا التعليق
شارك
عبدالله باقشير

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

قام بنشر
قام بنشر

السلام عليكم

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

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

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

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

رابط هذا التعليق
شارك
عبدالله باقشير

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

قام بنشر
قام بنشر

السلام عليكم

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

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

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

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

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

رابط هذا التعليق
شارك
عبدالله باقشير

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

قام بنشر
قام بنشر 

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

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع

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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept