نجوم المشاركات

Sub Test() Dim a, vArray(), sOut As String, i As Long, ii As Long, k As Long Application.ScreenUpdating = False a = Range("A2").CurrentRegion.Value ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 1) For i = LBound(a, 1) To UBound(a, 1) For ii = LBound(a, 2) To UBound(a, 2) k = k + 1 b(k, 1) = a(i, ii) Next ii Next i Columns("G").ClearContents Range("G2").Resize(UBound(b, 1), UBound(b, 2)).Value = b vArray = Application.Transpose(b) sOut = Join(vArray, vbCrLf) Open ThisWorkbook.Path & "\Output.txt" For Output As #1 Print #1, sOut Close #1 Application.ScreenUpdating = True MsgBox "Done...", 64, "LionHeart" End Sub

ممكن خيار آخر؟ بعد اذنكم Sub test2() Dim a As Variant Dim i As Long a = Cells(2.1).CurrentRegion Columns("H").ClearContents For i = 2 To UBound(a) Cells(Cells(Rows.Count, 8).End(xlUp).Row + 1, 8).Resize(4) = Application.Transpose(Application.Index(a, i, Array(1, 2, 3, 4))) Next End Sub Sub test2() Dim a As Variant Dim i As Long Columns("H").ClearContents a = Cells(2.1).CurrentRegion For i = 2 To UBound(a) b = IIf(b <> "", b & vbCrLf & Join(Application.Index(a, i, x), vbCrLf), _ Join(Application.Index(a, i, Application.Transpose(Evaluate("row(1:" & UBound(a, 2) & ")"))), vbCrLf)) Next Cells(2, 9).Resize((UBound(a) - 1) * UBound(a, 2)) = Application.Transpose(Split(b, vbCrLf)) Open ThisWorkbook.Path & "\MOutput.txt" For Output As #1 Print #1, b Close #1 End Sub

ما لم أفهمه كيف أتت الأرقام 450 100 50؟؟؟!!!!

ربما ؟ Sorting test (n)1 (1).xlsm

أهلا أخي الحلبي .. هذا تصميم عملته بالفوتوشوب وضعته كخلفية للفورم وركبت عليه زر مخفي 🙂 وطبعا مربعات اسم المستخدم وكلمة المرور بدون حدود والخلفية باللون الأبيض أو شفاف

السلام عليكم \مشاركه مع اخى الاستاذ @Moosak جزاه الله خيرا اتفضل حاجه على قد حالى عملت لك اول طلب على اول استعلام حاول تنفذ انت الطلب التانى اخى @omran2015 Function dragat(t1 As Integer, t2 As Integer, t3 As Integer, t4 As Integer, t5 As Integer, t6 As Integer) If t1 >= 50 And t2 >= 50 And t3 >= 50 And t4 >= 50 And t5 >= 50 And t6 >= 50 Then dragat = "ناجح" Else dragat = "دور ثان" End If End Function بالتوفيق Data_Base.mdb

السلام عليكم أخي الكريم يمكنك استخدام المعادلة التالية، أرجو أن تكون حلاً لاستفسارك =IF(COUNTIF($A$7:A7;A7)=1;SUMIF(MARCH!A7:A44;Data!A7;MARCH!I7:I114);"") تقبل تحياتي العطرة والسلام عليكم new.xlsx

ما شاء الله بارك الله كود رائع أخي الكريم @lionheart زادكم الله علماً وحلماً آمين يا ربّ العالمين.

السلام عليكم أخي الكريم يمكنك فعل ذلك بشكل آلي كلما غيرت في الشيت إلا أنه سيكون مرهقاً لك وخصوصاً حجم البيانات كبير وفق الكود ذاته تضعه في حدث ورقة البيانات ( ملف وتحريري نصف العام صف رابع) كما يلي: Private Sub Worksheet_Change(ByVal Target As Range) 'متغيرات Dim arr As Variant Dim i As Variant Dim cr As Variant Dim j As Long 'اسم شيت المصدر واسم الخليه الاولى منه arr = Sheets("ملف وتحريري نصف العام صف رابع").Range("b14").CurrentRegion.Value 'الأعمدة المطلوب الترحيل إليها cr = Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 36, 45, 56, 65, 76, 85, 96, 105, 116, 125, 136, 145, 156, 165, 192, 193, 198, 199, 204, 205, 210, 211, 216, 217, 19, 20, 21, 28, 29, 30, 39, 40, 41, 48, 49, 50, 59, 60, 61, 68, 69, 70, 79, 80, 81, 88, 89, 90, 99, 100, 101, 108, 109, 110, 119, 120, 121, 128, 129, 130, 139, 140, 141, 148, 149, 150, 159, 160, 161, 168, 169, 170) 'أرقام الأعمدة المطلوب ترحيلها For Each i In Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 19, 20, 22, 23, 25, 26, 28, 29, 31, 32, 34, 35, 37, 38, 40, 109, 41, 110, 42, 111, 43, 112, 44, 113, 45, 46, 47, 77, 78, 79, 49, 50, 51, 81, 82, 83, 53, 54, 55, 85, 86, 87, 57, 58, 59, 89, 90, 91, 61, 62, 63, 93, 94, 95, 65, 66, 67, 97, 98, 99, 69, 70, 71, 101, 102, 103, 73, 74, 75, 105, 106, 107) 'اسم شيت الهدف ورقم صف صفحة الهدف Sheets("سجل").Cells(14, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i) j = j + 1 Next i End Sub ولذلك الأفضل التعديل على الموديول لديك كما يلي: Sub Test1() 'متغيرات Dim arr As Variant Dim i As Variant Dim cr As Variant Dim j As Long 'اسم شيت المصدر واسم الخليه الاولى منه arr = Sheets("ملف وتحريري نصف العام صف رابع").Range("b14").CurrentRegion.Value 'الأعمدة المطلوب الترحيل إليها cr = Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 36, 45, 56, 65, 76, 85, 96, 105, 116, 125, 136, 145, 156, 165, 192, 193, 198, 199, 204, 205, 210, 211, 216, 217, 19, 20, 21, 28, 29, 30, 39, 40, 41, 48, 49, 50, 59, 60, 61, 68, 69, 70, 79, 80, 81, 88, 89, 90, 99, 100, 101, 108, 109, 110, 119, 120, 121, 128, 129, 130, 139, 140, 141, 148, 149, 150, 159, 160, 161, 168, 169, 170) 'أرقام الأعمدة المطلوب ترحيلها For Each i In Array(2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, 19, 20, 22, 23, 25, 26, 28, 29, 31, 32, 34, 35, 37, 38, 40, 109, 41, 110, 42, 111, 43, 112, 44, 113, 45, 46, 47, 77, 78, 79, 49, 50, 51, 81, 82, 83, 53, 54, 55, 85, 86, 87, 57, 58, 59, 89, 90, 91, 61, 62, 63, 93, 94, 95, 65, 66, 67, 97, 98, 99, 69, 70, 71, 101, 102, 103, 73, 74, 75, 105, 106, 107) 'اسم شيت الهدف ورقم صف صفحة الهدف Sheets("سجل").Cells(14, cr(j)).Resize(UBound(arr, 1)).Value = Application.Index(arr, , i) j = j + 1 Next i End Sub والله أعلم والسلام عليكم

Sub test() Dim A As Variant: Dim w As Variant Dim i As Long: Dim ii As Long A = Cells(1, 1).Resize(Cells(Rows.Count, 4).End(xlUp).Row, 11) With CreateObject("scripting.dictionary") For i = 1 To UBound(A) If Not .exists(A(i, 6) & "#" & A(i, 4)) Then .Add A(i, 6) & "#" & A(i, 4), Array(A(i, 9), A(i, 10), A(i, 11)) Else w = .Item(A(i, 6) & "#" & A(i, 4)) For ii = 0 To UBound(w) w(ii) = w(ii) + A(i, ii + 9) Next .Item(A(i, 6) & "#" & A(i, 4)) = w End If Next Sheets("الخلاصة").Cells(1, 1).Resize(.Count) = Application.Transpose(.keys) Sheets("الخلاصة").Cells(1, 1).Resize(.Count).TextToColumns Destination:=Range("A1"), OtherChar:="#", FieldInfo:=Array(Array(2, 1)) Sheets("الخلاصة").Cells(1, 3).Resize(.Count, 3) = Application.Index(.items, 0, 0) Sheets("الخلاصة").Select End With End Sub

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

اتفضل اخى ارجو يكون هذا هو المطلوب test.accdb

قضية الاساسي 2022 اخر حاجة.xlsm

اولا يجب التاكد من التنسيق عندك فالجهاز لايتعرف على التاريخ كتاريخ بل كنص مما لايتماشى مع المعادلة انظري للمرفق اختاري من القائمة التاريخ وانظري للنتاج Time.xlsx

تفضل جرب هذا الملف رسائل واتس كصورة للنطاق1.xlsm

جرب هذا الملف متعقب حضور الموظفين.xlsm

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

هذا هو ما اتمناه اخي الكريم ولا اعرف كيف اشكرك على تعبك ومجهودك العظيم

الله على ابداعك يا ابو خليل تسلم ايديك بس يا ريت ميكونش فيه تكرار ويكون كل حرف واخد حقه في البدء به او التثنية به او التثليث او غير ذلك مع بقية الحروف بمعنى لو اخترنا مثلا كلمة كتب فيجب ان يكون هناك كلمتان تبدأ بحرف الكاف ويكون ترتيب الأولى كتب والثانية كبت ويجب ان يكون هناك كلمتان تبدأ بحرف التاء وهما تكب وتبك ويجي ان يكون هناك كلمتان تبدأ بحرف الباء وهما بكت وبتك وهكذا فتكون الكلمة المكونة من 3 حروف مولدة ل6كلمات و ينطبق هذا كله على اي كلمة بدون تكرار ولا اعرف اذا اردت كلمة مكونة من 6 حروف فكم يكون عدد الكلمات المولدة بالضبط ربما حضرتك تعرف وشكرا لتعاونك المثمر والفعال جعله الله في ميزان حسناتك