زكي 1979 قام بنشر فبراير 28, 2018 مشاركة قام بنشر فبراير 28, 2018 هذا الكود للبحث وأستخلاص نتائج من مجموعة شيتات لكن المشكل أنه يستخرج نتائج شيت واحدة فقط. كما أنه لا يسمح بتكرار الأستعلام اكثر من مرة. اين الخطأ أيها المبدعون؟ Sub Searching() i = 8 For sh = 2 To Sheets.Count For Each C In Sheets(sh).Range("F8:F" & Sheets(sh).Cells(Rows.Count, "F").End(xlUp).Row) If C = Sheets(1).[B3] Then Sheets(1).Cells(i, 1) = Sheets(sh).Name Sheets(1).Cells(i, 2) = Sheets(1).[B3] For j = 3 To 9 Sheets(1).Cells(i, j) = Sheets(sh).Cells(C.Row, j + 4).Value Next i = i + 1 End If Next Next End Sub programe.xlsm رابط هذا التعليق شارك More sharing options...
ابراهيم الحداد قام بنشر فبراير 28, 2018 مشاركة قام بنشر فبراير 28, 2018 السلام عليكم ورحمة الله استخدم هذا الكود Sub suivie2() Dim Sh As Worksheet, ws As Worksheet, C As Range Dim i As Long, p As Long Dim x, y, z Set Sh = Sheets("suivie") x = Year(Sh.Range("B3")) y = Month(Sh.Range("B3")) z = Day(Sh.Range("B3")) For Each ws In ThisWorkbook.Worksheets If ws.Name <> "suivie" Then For Each C In ws.Range("F8:F" & ws.Range("F" & Rows.Count).End(xlUp).Row) If Year(C.Value) = x Then If Month(C.Value) = y Then If Day(C.Value) = z Then p = p + 1 Sh.Cells(p + 7, 1) = ws.Range("D5") For i = 0 To 7 Sh.Cells(p + 7, i + 2) = C.Offset(0, i) Next End If End If End If Next End If Next End Sub رابط هذا التعليق شارك More sharing options...
زكي 1979 قام بنشر فبراير 28, 2018 الكاتب مشاركة قام بنشر فبراير 28, 2018 شكرا. جاري المحاولة رابط هذا التعليق شارك More sharing options...
زكي 1979 قام بنشر مارس 1, 2018 الكاتب مشاركة قام بنشر مارس 1, 2018 اخي زيزو شكرا جزيلا على الكود. يعمل بشكل جميل لكن هناك مشكلة فيه. انه عند اعادة البحث يبقى البحث السابق موجود مع انه غير متطابق مع تاريخ البحث. رابط هذا التعليق شارك More sharing options...
ابراهيم الحداد قام بنشر مارس 1, 2018 مشاركة قام بنشر مارس 1, 2018 السلام عليكم ورحمة الله استبدل الكود السابق بهذا الكود Sub suivie() Dim Sh As Worksheet, ws As Worksheet, C As Range Dim i As Long, p As Long Dim x, y, z Set Sh = Sheets("suivie") Sh.Range("A8:I" & Sh.Range("B" & Rows.Count).End(xlUp).Row).ClearContents x = Year(Sh.Range("B3")) y = Month(Sh.Range("B3")) z = Day(Sh.Range("B3")) For Each ws In ThisWorkbook.Worksheets If ws.Name <> "suivie" Then For Each C In ws.Range("F8:F" & ws.Range("F" & Rows.Count).End(xlUp).Row) If Year(C.Value) = x Then If Month(C.Value) = y Then If Day(C.Value) = z Then p = p + 1 Sh.Cells(p + 7, 1) = ws.Range("D5") For i = 0 To 7 Sh.Cells(p + 7, i + 2) = C.Offset(0, i) Next End If End If End If Next End If Next رابط هذا التعليق شارك More sharing options...
زكي 1979 قام بنشر مارس 1, 2018 الكاتب مشاركة قام بنشر مارس 1, 2018 شكرا جزيلا استاذي الكريم وبارك الله لك في اهلك جميعا. الف شكر رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.