سليم حاصبيا

تم التعديل كما تريد (كنت لا أريد ان تتكرر السنوات امام تكرار الاسماء ) Option Explicit Sub extarct_recorde() Dim dict As Object Dim Sh As Worksheet, i%: i = 3 Dim Ky, k, itm Set Sh = Sheets("ورقة1") Set dict = CreateObject("Scripting.Dictionary") With Sh .Range("H3").Resize(.Range("H3") _ .CurrentRegion.Rows.Count).ClearContents Do Until .Range("C" & i) = vbNullString k = Sh.Range("C" & i): itm = Sh.Range("F" & i) If Not dict.exists(k) Then dict.Add k, itm Else dict(k) = dict(k) & "-" & itm End If i = i + 1 Loop i = 3 Do Until .Range("C" & i) = vbNullString .Range("H" & i) = dict(.Range("C" & i).Value) i = i + 1 Loop End With Set dict = Nothing: Set Sh = Nothing End Sub

اخي محي الدين اظن انه لا حاجة للأمر Select عدة مرات مما يرهق البرنامج دون فائدة ولا حاجة للحلقة التكرارية مرة ثانية لاستخراج Items من Dictionary يكفي وضع هذا السطر ما بين علامات الــــ +++ Sub test() Dim a As Variant, lr, i lr = Cells(Rows.Count, 2).End(xlUp).Row a = Range("b3:b" & Cells(Rows.Count, 2).End(xlUp).Row).Resize(, 6) Cells(3, "H").Resize(100).ClearContents With CreateObject("scripting.dictionary") For i = 1 To UBound(a) If a(i, 1) <> 0 Then If Not .exists(a(i, 1)) Then .Add a(i, 1), a(i, 5) Else .Item(a(i, 1)) = .Item(a(i, 1)) & "-" & a(i, 5) End If End If Next '+++++++++++++++++++++++++++++++++++++++ Cells(3, "H").Resize(.Count) = Application.Transpose(.items) '++++++++++++++++++++++++++++++++++++++++ End With End Sub

ممكن ان يكون الحل Crezy_sequance.xlsx

تم التعديل كما تريد Option Explicit Sub transfer_data() Dim Source_sh As Worksheet Dim Target_sh As Worksheet Dim last_ro%, N_ro% Set Source_sh = Sheets("ورقة1") last_ro = Source_sh.Cells(Rows.Count, 3).End(3).Row If last_ro < 10 Then Exit Sub Select Case Source_sh.Range("c2") Case "أ": Set Target_sh = Sheets("نوبة أ") Case "ب": Set Target_sh = Sheets("نوبة ب") Case "ج": Set Target_sh = Sheets("نوبة ج") Case "د": Set Target_sh = Sheets("نوبة د") Case "ه": Set Target_sh = Sheets("نوبة ه") Case "و": Set Target_sh = Sheets("نوبة و") End Select N_ro = Target_sh.Cells(Rows.Count, 1).End(3).Row + 1 Target_sh.Range("a" & N_ro).Resize(last_ro - 9, 6).Value = _ Source_sh.Range("B10").Resize(last_ro - 9, 6).Value End Sub الملف مرفق EHSAA3_1.xlsm

لا حاجة لفعل اي شيء فقط اختر من القائمة المنسدلة اي حرف ا/ب/ج/ الخ.... والمعادلات تقوم بالواجب

بعد اذن الاخ علي هذا الكود Option Explicit Sub get_data() Rem ====>> Created By Salim Hasbaya On 2/11/2019 Dim Sh1 As Worksheet, Sh2 As Worksheet Dim tabL1 As Range Dim i%, Ro%, x% Set Sh1 = Sheets("Sheet1") Set Sh2 = Sheets("Sheet2") Set tabL1 = Sh1.Range("A1").CurrentRegion Sh2.Cells(9, 3).Resize(100, 500).ClearContents Ro = tabL1.Rows.Count For i = 3 To 95 Step 3 tabL1.AutoFilter 1, Sh2.Cells(5, i) x = tabL1.SpecialCells(12).Count If x > 4 Then tabL1.Offset(1).Resize(Ro - 1) _ .SpecialCells(12).Offset(, 1).Resize(, 3).Copy _ Sh2.Cells(9, i) End If Next i If Sh1.AutoFilterMode Then Sh1.ShowAllData: tabL1.AutoFilter End If End Sub الملف مرفق tarhil.xlsm

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

جرب هذا الملف( بدون كود) EHSAA3.xlsm

استبدل المعادلة بهذه

لا أفهم المشكلة الملف مع المعادلة Boook1.xlsx

في الخلية C11 هذه المعادلةواسحب يميناً لغاية العامودF و نزولاً صفين =INDEX($B$2:$F$3,MATCH($A11,$A$2:$A$3,0),MATCH(B$10,$B$1:$E$1,0))

جرب هذا الكود Option Explicit Sub HID_COLUMNS() Dim I% Range(Cells(1, 5), Cells(1, 262)).EntireColumn.Hidden = True For I = 13 To 262 Step 8 Cells(1, I).EntireColumn.Hidden = False Next End Sub

في المعادلة السابقة قلت لك ( الرقم 10 هو درجة الاكمال و يمكن تغييرها) فقم باستبدال الرقم 10 الى 50

لك ما تريد comp_2_tabl.xlsx

تم معالجة الامر moukmel.xlsx

لم افهم بالضبط ماذا تريد 1- ما موجود في الجدول الاول و غير موجود في الثاني؟ أو 2-ما موجود في الجدول الثاني و غير موجود في الاول؟ أو 3- المشترك بين الجدولين؟

هات الملف (نموذج ما لا يزيد عن 5 صفوف) و خذ ما يدهش العالم

هذه المعادلة (اذا كنت تريد ان تعتبر الغائب مكملاً) الرقم 10 هو درجة الاكمال و يمكن تغييرها =COUNTIF(D6:K6,"<=10")+COUNTIF(D6:K6,"غ")

جرب هذا المعادلة =IF(C11="","",VLOOKUP(C11,$B$3:$C$7,2,0)-SUMIFS($F$11:F11,$C$11:C11,C11))

صديقي لا حاجة للفلتر في هذا الحالة filter_sans_filter.xlsx

كلامك صحيح استاذ بن علية لم انتبه لهذه الحالة زيادة في اثراء الموضوع =IF(D4<C4,"لا يستحق",SUM(N(D4),-N(C4),N(B4))) او =IF(D4<C4,"لا يستحق",N(D4)-N(C4)+N(B4))

See this file faltara.xls

حيث ان دالة Sum تحستب الفراغ او النص بقيمة صفر بينما عملية الجمع العادية (+) لا تعمل بوجود فراغات أو نصوص لذلك المعادلة الصحيحة =IF(D4<C4,"لا يستحق",SUM(D4,-C4,B4))

الحرف m هو رقم الصف الدي ستبدأ به البيانات في صفحة Summary التسلسل 1 to 3 to الرقم 3 عدد الصفحات التي يجب على الكود ان لا يتعاطى معها لاننا نريد استثناءها من عمل الكود (Summary /ٍCustomers / Products) R هو عدد الصفوف الممتلئة في كل صفحة ابتداءً من الخلية B9 B9 بداية البيانات في كل صفحة الرقم 6 يدل على اللون الاصفر "H:H,D:D, C:C" الأعمدة التي لا حاجة لها(يتم مسحها)

صباح الثورة من بيروت/صيدا/النبطية/صور /طرابلس .....ومن كل شبر من أرض لبنان الحبيب اليوم الثاني عشر جرب هذا الملف example.xlsx