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

[جمال جبريل]

كود بحث عن كلمة في جميع الاوراق وكتابتها في ورقة جديدة بحيث يبحث في ورقة محددة وهي ورقة (" البحث في المكتبة") وفي نطاق (C5:C65000) أي في خانة اسم الكتاب فقط لا غير.

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

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

السلام عليكم

البحث في ورقة ووضع النتائج في ورقة اخرى

Sub Kh_Find1()

Static MySve As String

Dim MyTextFind As Variant

Dim MyShFind As Worksheet

Dim RngPast As Range

Dim C As Range

Dim Mch As Variant

Dim i As Integer


On Error GoTo 1


MyTextFind = Application.InputBox("اكتب ما تريد البحث عنه ؟", "بحث", MySve, 100, 100, , , 2)

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


Set MyShFind = Worksheets("البحث في المكتبة")

Set RngPast = Worksheets("نتائج البحث").Range("C2")


With RngPast

.Worksheet.Activate

Range(.Cells, .Cells.End(xlDown)).ClearContents

End With


With MyShFind.Range("C1:C65000")

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

If Not C Is Nothing Then

firstAddress = C.Address

Do

i = i + 1

Mch = Mch & IIf(i = 1, "", "^^") & C.Value2

Set C = .FindNext(C)

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

End If

End With


'====================================

If i Then

MySve = MyTextFind

If i > 1 Then Mch = WorksheetFunction.Transpose(Split(Mch, "^^"))

RngPast.Resize(i, 1).Value = Mch

MsgBox "عدد نتائج البحث : " & i

Else

MsgBox "لا توجد نتائج للبحث "

End If

'====================================

1:

If Err Then MsgBox "Err.Number : " & Err.Number: Err.Clear


Set MyShFind = Nothing

Set RngPast = Nothing

Set C = Nothing

Mch = Empty

End Sub

المرفق 2003

كود بحث.rar

[جمال جبريل]

شكرا جزيلا على تجاوبك معنا ، ولكن نريد فقط استخراج بيانات اخرى منها الرقم الخاص ، النوع ، والتصنيف والمقدمة اليه ، بالاضافة الي ان يكون بند يوضح مكانه عند الضغط عليه ينقله الي مكانه (ارتباط تشعبي).

[أبو محمد عباس]

السلام عليكم

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

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

ودمتم برعاية الله وحفظه

كود بحث.rar

[جمال جبريل]

فتح الله عليكما ، وزودكم من العلم ان شاء الله.

طيب علمونا شوية ، كيف يمكنني التحكم في ما اريد ان اعرضه بالضبط (اي سطر).

باالاضافة الي انني اريد ان اضيف عمود يظهر لي مكان الخلية المعروضة بالارتباط التشعبي.

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

ما شاء الله

كود بحث رائع جداً وسريع

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

السلام عليكم

الاخ الفاضل / عباس السماوي --------------حفظه الله

اكرمك الله في الدارين عمل ذكي

تقبل تحياتي وشكري

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

ما شاء الله

كود بحث رائع جداً وسريع

غرض البحث للخلايا

Range

Find

Function Find(What, [After], [LookIn], [LookAt], [SearchOrder], [SearchDirection As XlSearchDirection = xlNext], [MatchCase], [MatchByte], [SearchFormat]) As Range

    Member of Excel.Range

سريع جدا

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

فتح الله عليكما ، وزودكم من العلم ان شاء الله.

طيب علمونا شوية ، كيف يمكنني التحكم في ما اريد ان اعرضه بالضبط (اي سطر).

باالاضافة الي انني اريد ان اضيف عمود يظهر لي مكان الخلية المعروضة بالارتباط التشعبي.

شاهد الرابط التالي

جعلت فيه طلبك هذا

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

[أبو محمد عباس]

السلام عليكم

الاستاذ الفاضل والعالم الكبير عبد الله باقشير المحترم اعلى الله سبحانه وتعالى مقامكم الكريم وزادك الله سبحانه وتعالى من فضله علما ومعرفة وحفظكم ورعاكم

انه لشرف كبير لي ان يذكر اسمي على لسان عالم كبير وجليل وهذا تواضع الاساتذه والعلماء الكبار في التعليم التربوي والعلمي جزاك الله سبحانه وتعالى كل خير

والسلام عليكم ورحمة الله وبركاته

[جمال جبريل]

للاستاذ عبد الله باقشسر المحترم فعلا استاذ على حق ، وذادك الله من العلم اكثر واكثر وتعلم غيرك من العرب والمسلمين.

[جمال جبريل]

فقط لي طلب .... كيف يمكنني تغيير مثلا ( العمود الذي يبحث فيه ، الورقة التي تبحث فيها ، البيانات الذي اريد ان استخرجها مثلا اضافة عمود جديد مثل عدد النسخ ، بداية الكتابة مثلا من البداية الصف الثاني والعمود الثاني ، اي يبدا ( A2:F2).