الخالدي

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

السلام عليكم ورحمة الله المعادلة في العمود H يوجد بها الدالة T() وهي تستخدم مع عمود نصي وفي حال حذفها سيظهر بدلا من الفرغات القيمة صفر الاعمدة الرقمية استخدم معها الدالة IF مثل المعادلة في العمود I واذا كانت الاعمدة الرقمية لا تحتوي على القيمة صفر يمكن استخدام معها الدالة TEXT(XXX;"0;0;") حيث XXX هي معادلة الاستدعاء نفس الحال ينطبق على المعادلات في العمود L و M في حال كان جدول الاستدعاء يحتوي فقط على اعمدة رقمية وبها القيمة صفر ولا ترغب في ظهور القيمة صفر بدلا من الفراغات عندها تحتاج المعادلات الى تعديل في امان الله

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

السلام عليكم ورحمة الله ايضا من الفرق الدالة vlookup تبحث في الصفوف الدالة Match تبحث في الصفوف او الاعمدة وفرق اخر الدالة vlookup تبحث قيمة واحدة الدالة Match تبحث عن قيمة واحدة او مجموعة من القيم -هنا لا تستخدم مع Index كمرجع للصف وفرق اخر الدالة vlookup تُرجع النتيجة كـ قيمة اما Match و Index تُرجع النتيجة كـ مرجع لذلك يمكن استخدام النتيجة لدوال تتطلب مرجعا فمثلا لو استخدمناها وسيطا للدالة ROW نحصل على رقم صف الخلية في امان الله

السلام عليكم ورحمة الله جرب المرفق ديوان شعر11.rar

السلام عليكم ورحمة الله جرب المرفق في امان الله ديوان شعر10.rar

السلام عليكم ورحمة الله او ربما على الجهاز الاخر ليس مثبت مع الاوفيس Visual Basic

السلام عليكم ورحمة الله اعتقد من الجيد استخدام الجداول المحورية فهي توفر التلخيصات والاحصائيات وبدون عبء على الملف كالمعادلات ايضا مرونة اكثر من الاكواد في التعديل والتحوير بالإضافة الى تقديم الإحصائيات فالجداول المحورية يمكنها عرض الاوائل ويمكن تفصيلها حسب الفصول او المواد او بشكل اجمالي ربما اصحاب الاختصاص والمطلعين على مختلف الطرق لهم رأي اخر في امان الله

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

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

السلام عليكم ورحمة الله ما دام مر من هنا الاستاذ/ جمال عبد السميع -حفظه الله- فقد كفى و وفى لكن للفائدة واثراء للموضوع في المرفق البحث بشرطين او بشرط وبمعادلة صفيف وغير صفيف في امان الله البحث بقيمتين او اقل - معادلة صفيف وغيرصفيف.rar

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

صعب من اي ناحية اختار تصفية للعشرة الاوائل وحدد أعلى رقم 1 والسلام عليكم

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

السلام عليكم ورحمة الله المطلوب غير واضح مع ذلك جرب الاتي ادخل المعادلة التالية في الخلية D12 واسحبها للأسفل =INT((ROW()-12)/7)+1 او معادلة ترقيم ثنائي =TEXT(INT((ROW()-12)/7)+1&MOD(ROW()-12; 7)+1;"0-0") او معادلة ترقيم ثنائي حرفي =SUBSTITUTE(ADDRESS(1;INT((ROW()-12)/7)+1;4); "1"; "-"&MOD(ROW()-12; 7)+1) ارجو ان يكون المطلوب في امان الله

السلام عليكم ورحمة الله بما انك تستخدم الجداول المحورية PivotTable فيمكنك الاستفادة من مزاياها لتحقيق ما يماثل طلبك ان كنت فهمته مثلا الجدول المحوري في الورقة HC_Legal انقر نقرتين على خلية في عمود القيم(Count….) مقابل احد عناصر عمود تسميات الصفوف(Position) مثلا نقرتين على الخلية C27 ايضا اكتشف ميزة اخرى بالنقر مرتين على احد عناصر عمود تسميات الصفوف(Position) ارجوا ان يكون هناك فائدة من مشاركتي في امان الله

السلام عليكم ورحمة الله الكود التالي يضيف ارتباط تشعبي في العمود D ورقة الطلب الاول ضع الكود في حدث تغير الورقة Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 1 And Target.Column = 1 Then For Each C In Intersect(Target, [A2:A10000]) Pth = ActiveWorkbook.Path & "\" & C & ".pdf" C(1, 4).Hyperlinks.Delete If C = "" Then C(1, 4) = "" Else If Dir(Pth) <> "" Then C(1, 4).Hyperlinks.Add C(1, 4), Pth, , , "فتح الملف" Else C(1, 4) = "الملف غير متوفر" End If End If Next End If End Sub ارجو ان يكون المطلوب في امان الله

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

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

السلام عليكم ورحمة الله جزاك الله خيرا واحسن اليك ولك مثل دعائك لي اخي الكريم جرب التعديل التالي للكود Sub AL_KHALEDI() With Sheets("بيانات") Set Rng = Range(.Cells(3, 1), .Cells(Rows.Count, 1).End(xlUp)(1, 49)) End With Col = Application.Match([A1], Rng.Rows(0), 0) + 1 ReDim Arr(1 To 3, 1 To 3) For r = 1 To Rng.Rows.Count If Rng(r, Col) <> "" And Rng(r, 2) = [A3] Then If Application.CountIfs( _ Rng(1, 2).Resize(r), Rng(r, 2), _ Rng(1, 5).Resize(r), Rng(r, 5), _ Rng(1, 6).Resize(r), Rng(r, 6), _ Rng(1, Col).Resize(r), Rng(r, Col)) = 1 Then W = Application.Match(Rng(r, 5), [{"الخط الأول","الخط الثاني","الخط الثالث"}], 0) H = Application.Match(Rng(r, 6), [{"الوردية الصباحية","الوردية المسائية","الوردية الليلية"}], 0) If Not IsError(W) And Not IsError(H) Then Arr(W, H) = Arr(W, H) & Rng(r, Col).Value & Chr(10) End If: End If: End If Next r For Each C In [M8:O8,M18:O18,M28:O28] C.Value = "" L = Len(Arr(A Mod 3 + 1, Int(A / 3) + 1)) If L Then C.Value = Mid(Arr(A Mod 3 + 1, Int(A / 3) + 1), 1, L - 1) A = A + 1 Next C Set Rng = Nothing: Erase Arr MsgBox "تم بحمد الله" End Sub

السلام عليكم ورحمة الله حسب مافهمت من المطلوب جرب الكود المرفق الكود يعمل على اكسل2007 وما فوق ويعتمد على تاريخ الشهر في الخلية A2 بدلا من الخلية B2 Sub AL_KHALEDI() With Sheets("بيانات") Set Rng = Range(.Cells(3, 1), .Cells(Rows.Count, 1).End(xlUp)(1, 49)) End With Col = Application.Match([A1], Rng.Rows(0), 0) ReDim Arr(1 To 3, 1 To 3) For r = 1 To Rng.Rows.Count If Rng(r, Col) <> "" And Rng(r, 1) = [A2] Then If Application.CountIfs(Rng(1, 2).Resize(r), Rng(r, 2), Rng(1, 5).Resize(r), Rng(r, 5), Rng(1, 6).Resize(r), Rng(r, 6)) = 1 Then W = Application.Match(Rng(r, 5), [{"الخط الأول","الخط الثاني","الخط الثالث"}], 0) H = Application.Match(Rng(r, 6), [{"الوردية الصباحية","الوردية المسائية","الوردية الليلية"}], 0) If Not IsError(W) And Not IsError(H) Then Arr(W, H) = Arr(W, H) + Rng(r, Col).Value End If: End If: End If Next r For Each C In [M8:O8,M18:O18,M28:O28] C.Value = Arr(A Mod 3 + 1, Int(A / 3) + 1) + 0 A = A + 1 Next C Erase Arr MsgBox "تم بحمد الله" End Sub ارجو ان يكون المطلوب في امان الله مجاميع بشروط وبدون تكرار2007.rar

السلام عليكم ورحمة الله بارك الله فيك وجزاك خيرا ولك مثل دعائك لي واكثر والحمد لله رب العالمين

السلام عليكم ورحمة الله اضافة الى رأي الاستاذ الفاضل/ شوقي ربيع حفظة الله قم باضافة كلمة PtrSafe بعد كلمة Declare واذا ترغب بان يعمل الكود على 64 او32 بت استخدم الدالة #If على الشكل التالي #If VBA7 Then Declare PtrSafe ... #Else Declare ... #End If في احيان اخرى قدم يلزم تعديل نوع المتغير في امان الله

السلام عليكم ورحمة الله الكود السابق يقوم بالترحيل بدون تكرار الية الكود تعمل مثلا في الورقة (تم التنفيذ) اذا كان يوجد 4 صفوف مرحلة سابقا فالكود يقوم بالترحيل من الورقة (التسويق) بعد المرور على 4 صفوف باسم الورقة (تم التنفيذ) جرب المرفق بعد تعديل عمود الاحصاء في الكود الكود المرفق يقوم بالترحيل وحذف الصفوف المرحلة ارجو ان يكون المطلوب في امان الله ترحيل.rar

السلام عليكم ورحمة الله اسال الله ان يفرج همك وهم كل المسلمين الوقت متأخر لذا تعديل الكود على عجالة لحين مشاركة بقية الاخوة Sub amir() Dim cl As Range, i As Integer Dim R1 As Integer, R2 As Integer For i = 2 To 4 R1 = Sheets(i).[O10000].End(xlUp).Row - 1 R2 = 0 For Each cl In Range("O2:O" & [O10000].End(xlUp).Row) If cl.Value = Sheets(i).Name Then R2 = R2 + 1 If R2 > R1 Then cl.Offset(0, -13).Resize(1, 14).Copy Sheets(i).Range("B" & Sheets(i).[b10000].End(xlUp).Row + 1) End If End If Next Next End Sub في امان الله