البحث فى كامل جدول البيانات

[SPHINX]

يرجى الاطلاع على الكود الاتي

[code]Sub INQUR()
Sheets("INQURY").Select
ActiveSheet.Rows.Hidden = False
[A3:AD500].ClearContents
s = ""
s = Application.InputBox("!ÃÏÎá ÇáßáãÉ ÇáÊí ÊæÏ ÇáÈÍË ÚäåÇ", "ÈÍË")
If s = False Then Exit Sub
'If s = "" Then Exit Sub
Application.ScreenUpdating = False
    With Sheets("TRCK").[A3:AD2000]
    Set MySearch = .Find(s, LookAt:=xlWhole)
    If Not MySearch Is Nothing Then
        F = MySearch.Address
        Myrow = 3
        Do
            x = MySearch.Row
            y = MySearch.Column
            For MyColumn = 1 To 30
                Sheets("INQURY").Cells(Myrow, MyColumn) = .Cells(x, MyColumn)
            Next MyColumn
            Myrow = Myrow + 1
            Set MySearch = .FindNext(MySearch)
        Loop While Not MySearch Is Nothing And MySearch.Address <> F
    End If
End With
For A = 50 To 1000
    If Cells(A, 1) = "" Then Rows(A).Hidden = True
Next
ActiveWindow.SmallScroll Down:=-100
Application.ScreenUpdating = True
If Application.WorksheetFunction.CountA([A3:AD500]) = 0 Then
    MsgBox "!&aacute;&Ccedil; &iacute;&aelig;&Igrave;&Iuml; &Atilde;&iacute; &Egrave;&iacute;&Ccedil;&auml;&Ccedil;&Ecirc; &Iacute;&aelig;&aacute; &Ccedil;&aacute;&szlig;&aacute;&atilde;&Eacute; &Ccedil;&aacute;&Ecirc;&iacute; &Egrave;&Iacute;&Euml;&Ecirc; &Uacute;&auml;&aring;&Ccedil;", vbExclamation, "&Uacute;&Yacute;&Uuml;&aelig;&Ccedil;&eth;"
'Else: Msg = MsgBox("&aring;&aacute; &Ecirc;&aelig;&Iuml; &Oslash;&Egrave;&Ccedil;&Uacute;&Eacute; &auml;&Ecirc;&Ccedil;&AElig;&Igrave; &Ccedil;&aacute;&Egrave;&Iacute;&Euml;&iquest;", vbQuestion + vbYesNo, "&Ecirc;&Atilde;&szlig;&iacute;&Iuml; &Oslash;&Egrave;&Ccedil;&Uacute;&Eacute;")
    'If Msg = vbYes Then PrintOut
End If
End Sub

ما يفعله الكود ان يقوم بالبحث عن الكلمة المراده وعند نسخ ولصق البيانات يهمل عدد صفين من فوق ويضيف صفين من تحت

بذلت كافه المحاولات ولم اتوصل للحل

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

تم تعديل يناير 4, 2007 بواسطه SPHINX

[omar elhosseini]

الاخ SPHINX

تحياتى

شاهد المرفق اخى تم تعديل الكود

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

Officena2.rar

[SPHINX]

الحبيب نامر

اشكر لك مساعدتك

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

واود ان اعرف كيفية عمل الكود

Sub INQUR()
Sheets("INQURY").Select
ActiveSheet.Rows.Hidden = False
[A3:AD500].ClearContents
s = ""
s = Application.InputBox("!ÃÏÎá ÇáßáãÉ ÇáÊí ÊæÏ ÇáÈÍË ÚäåÇ", "ÈÍË")
If s = False Then Exit Sub
If s = "" Then Exit Sub
Application.ScreenUpdating = False
    With Sheets("TRCK").[A3:AD500]
    Set MySearch = .Find(s, LookAt:=xlWhole)
    If Not MySearch Is Nothing Then
        F = MySearch.Address
        MyRow = 3
        Do
            x = MySearch.Row
            y = MySearch.Column
            For MyColumn = 1 To 30
                Sheets("INQURY").Cells(MyRow, MyColumn) = Sheets("TRCK").Cells(x, MyColumn)
            Next MyColumn
            MyRow = MyRow + 1
            Set MySearch = .FindNext(MySearch)
        Loop While Not MySearch Is Nothing And MySearch.Address <> F
    End If
End With
For a = 3 To 500
    If Cells(a, 1) = "" Then Rows(a).Hidden = True
Next
ActiveWindow.SmallScroll Down:=-100
Application.ScreenUpdating = True
'If Application.WorksheetFunction.CountA([A3:S500]) = 0 Then
'    MsgBox "!&aacute;&Ccedil; &iacute;&aelig;&Igrave;&Iuml; &Atilde;&iacute; &Egrave;&iacute;&Ccedil;&auml;&Ccedil;&Ecirc; &Iacute;&aelig;&aacute; &Ccedil;&aacute;&szlig;&aacute;&atilde;&Eacute; &Ccedil;&aacute;&Ecirc;&iacute; &Egrave;&Iacute;&Euml;&Ecirc; &Uacute;&auml;&aring;&Ccedil;", vbExclamation, "&Uacute;&Yacute;&Uuml;&aelig;&Ccedil;&eth;"
'Else: Msg = MsgBox("&aring;&aacute; &Ecirc;&aelig;&Iuml; &Oslash;&Egrave;&Ccedil;&Uacute;&Eacute; &auml;&Ecirc;&Ccedil;&AElig;&Igrave; &Ccedil;&aacute;&Egrave;&Iacute;&Euml;&iquest;", vbQuestion + vbYesNo, "&Ecirc;&Atilde;&szlig;&iacute;&Iuml; &Oslash;&Egrave;&Ccedil;&Uacute;&Eacute;")
'    If Msg = vbYes Then PrintOut
'End If
End Sub

[omar elhosseini]

الاخ SPHINX

تحياتى لك

لم اقول انه لايعمل معك

ولكنى قلت لن يتناسب مع احتياجاتك فى البحث مستقبلا

واقصد من خلال جدول بياناتك ارى انك سوف تحتاج البحث فى مدى تاريخ معين اى من تاريخ محدد الى تاريخ محدد

وايضا سوف تحتاج مع الاعمدة الرقمية ان تبحث عن مدى مبلغ معين فى عامود اى من مبلغ محدد الى مبلغ محدد

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

تحياتى

[SPHINX]

استاذي تامر

لا اريد ان اثقل عليك

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

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

وذا كان من الممكن عن الرغبة في التعديل هل يمكن التعديل على شيت البحث ومن ثم يتم التعديل في الشيت الاصليه