ياسر خليل أبو البراء

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

جرب الكود التالي وإذا لم يفلح لابد من توضيح المسألة بشيء من التفصيل فقد لا يتعلق الأمر بالكود بل بطريقة الاستخدام في بعض الأحيان Sub Close_Files() Application.DisplayAlerts = False ThisWorkbook.Save Application.DisplayAlerts = True If Workbooks.Count = 1 Then Application.Quit Else ThisWorkbook.Close End If End Sub الرد بعد 10 أيام .. صدقني أنا نسيت الموضوع أصلاً حاول تتابع الموضوع لأن كل ما بعدت المسافة في الرد كلما نسيت .. الزهايمر ربنا يكفيك شره

نعم يمكن أخي الكريم أبو يوسف كل شيء ممكن .. شاهد الفيديو جيداً وحاول تعمل الكود بنفسك ، ولو تعثرت فيه ضع الكود ووضح النقطة التي تعثرت بها تقبل تحياتي

يمكن إضافة سطر في داخل نفس الحلقة التكرارية بهذا الشكل Sh.Cells(Lr, R).Value = Sh.Cells(Lr, R).Value -6 اضبط -6 لكي تتوافق مع ملفك ..أنا وضعت مجرد مثال هذا والله أعلم

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

إذاً قم بتغيير السطر التالي Sh.Cells(Lr, R).Value = Me.Controls("TextBox" & R).Value ليصبح بهذا الشكل Sh.Cells(Lr, R+1).Value = Me.Controls("TextBox" & R).Value

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

السلام عليكم (مفيش لا سلام .. ولا حتى كلام :: يا قلبك القاسي يا حوسو) بص يا سيدي جرب الكود التالي في حدث ورقة العمل (لو مش فاهم كلامي : اعمل كليك يمين على اسم ورقة العمل اللي هي Sheet1 .. مفيش غيرها عندك في الملف بتدور على ايه؟) عملت كليك يمين .. هتلاقي قايمة فيها أوامر اختار منها View Code .. وانسخ الكود اللي في المشاركة والصقه هناك وهو دا حدث ورقة العمل عشان متوهشي مني !! وآدي الكود عشان خاطر عيونك السود Private Sub Worksheet_Change(ByVal Target As Range) If Target.Cells.CountLarge > 1 Then Exit Sub If Target.Address = "$A$2" Then Dim c As Range Range("B3").Value = Target.Value For Each c In Range("C3:Z3") If c.Offset(, -1) = 1 Then c.Value = 2 ElseIf c.Offset(, -1) = 2 Then c.Value = 3 ElseIf c.Offset(, -1) = 3 Then c.Value = 1 End If Next c End If End Sub

العمل بالمعادلات بشكل عام مع كثرة المعادلات في الملف تثقل الملف وتجعله بطيئاً مع الوقت لكثرة الحسابات Calculations .. ولذا إذا كان هناك حلول بالبرمجة فهي أفضل وأيسر وأسرع في التعامل ، وتجعل البرامج والملفات الضخمة حجمها أقل بكثير .. هذا والله أعلم

غير الرقم 1 إلى 2 في هذا السطر For R = 1 To 28

وعلكيم السلام جرب التعديل التالي ' ==================================================== On Error Resume Next 'With MyRange.Cells(1, 0).Offset(ComboBox1.ListIndex) For R = 1 To 28 Sh.Cells(Lr, R).Value = Me.Controls("TextBox" & R).Value Next 'End With If MsgBox(" لقد تمت تعديل مرتب السيد/ " & (Me.TextBox1.Value), vbMsgBoxRight, "تاكيد التعديل ") = vbNo Then Exit Sub Else '================== خاص بتعديل البيانات ==================

وعليكم السلام أخي الكريم قمت بفحص الملف التنفيذي على الـ Virsutotal اوكتشف به نوعين من الفيروسات https://www.virustotal.com/en/file/fb28e3084c5767e05e9f96d4ef00f17becab44214dd924fabd0fd3fe5e8c5c94/analysis/1499491578/

وعليكم السلام أخي الكريم قم بإرفاق نموذج مصغر من ملفك وضع بعض النتائج المتوقعة أهلاً بك في المنتدى ونورت بين إخوانك تقبل تحياتي

لا يوجد فرق بين Sub و Public .. لكن الأمر يختلف إذا تم استخدام كلمة Private .. فهذا يعني أن اسم الماكرو لن يظهر في قائمة أسماء الماكرو عند الضغط على Alt + F8 .. أعتقد سطر الترتيب في النهاية بعد حذف التكرار ..

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

وجزيت خيراً بمثل ما دعوت لي أخي الكريم إليك كود آخر أسرع في التنفيذ .. Sub PossibleCombinations() Dim a, p As Long, u As Long, arr As Variant Dim i1 As Long, i2 As Long, i3 As Long, i4 As Long, i5 As Long, i6 As Long Dim tot1 As Long, tot2 As Long, tot3 As Long, tot4 As Long, tot5 As Long, tot6 As Long Debug.Print "Start At : " & Format$(Now, "HH:MM:SS") Const Target As Long = 14221 Const x As Long = 20 u = Rows.Count ReDim a(1 To 1048576, 1 To 13) arr = Array(49, 99, 149, 199, 224, 249) Application.ScreenUpdating = False For i1 = 1 To x tot1 = i1 * arr(0) If tot1 >= Target Then GoTo L1 For i2 = 1 To x tot2 = tot1 + i2 * arr(1) If tot2 >= Target Then GoTo L2 For i3 = 1 To x tot3 = tot2 + i3 * arr(2) If tot3 >= Target Then GoTo L3 For i4 = 1 To x tot4 = tot3 + i4 * arr(3) If tot4 >= Target Then GoTo L4 For i5 = 1 To x tot5 = tot4 + i5 * arr(4) If tot5 >= Target Then GoTo L5 For i6 = 1 To x tot6 = tot5 + i6 * arr(5) If tot6 = Target Then p = p + 1 If p > u Then GoTo Skipper a(p, 1) = i1 a(p, 2) = i2 a(p, 3) = i3 a(p, 4) = i4 a(p, 5) = i5 a(p, 6) = i6 a(p, 7) = i1 * 49 a(p, 8) = i2 * 99 a(p, 9) = i3 * 149 a(p, 10) = i4 * 199 a(p, 11) = i5 * 224 a(p, 12) = i6 * 249 a(p, 13) = tot6 End If L6: Next i6 L5: Next i5 L4: Next i4 L3: Next i3 L2: Next i2 L1: Next i1 Skipper: Range("A1").Resize(p, UBound(a, 2)).Value = a Application.ScreenUpdating = True Debug.Print "Stop At : " & Format$(Now, "HH:MM:SS") MsgBox "Done...", 64 End Sub

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

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

السلام عليكم هل هذا ما تريده ؟؟ اطلع على المرفق .. Sample.rar

نعم أخي ناصر .. تسجيل الماكرو يسجل التحديد وهو غير مطلوب في التعامل مع الأكواد حيث يسبب بطء شديد جرب التالي Sub نسخ() Sheets("Sheet1").Range("D7:D150").Copy Sheets("Sheet4").Range("F6").PasteSpecial Paste:=xlPasteValues End Sub

السلام عليكم أخي العزيز أبو يوسف .. كل عام وأنت بخير بفرض أن لديك مجموعة من النصوص تبدأ من الخلية A2 وفي العمود المجاور العدد المطلوب تكراره في العمود B ... قم بتجربة الكود التالي Sub Test() Dim arr() As String Dim i As Long Dim j As Long Dim cnt As Long ReDim arr(Application.Sum(Range("B2:B" & Range("B" & Rows.Count).End(xlUp).Row)) - 1) For i = 2 To Range("A" & Rows.Count).End(xlUp).Row For j = 0 To Range("B" & i).Value - 1 arr(cnt + j) = Range("A" & i).Value Next j cnt = cnt + j Next i Range("H2").Resize(UBound(arr) + 1, 1).Value = Application.Transpose(arr) End Sub

أخي الكريم أبو مالك قم بطرح طلبك في موضوع مستقل مع وضع ملف مرفق ووضع الأكواد بين قوسي الكود ليظهر بشكل منضبط

أخي الكريم إبراهيم جرب الكود التالي عله يفي بالغرض Option Explicit Sub PossibleCombinations() Dim r As Variant Dim v As Double Dim i As Long Dim a As Long Dim b As Long Dim c As Long Dim d As Long Dim e As Long Dim f As Long Const x As Long = 20 ReDim r(1 To 1048576, 1 To 13) Application.ScreenUpdating = False For a = 1 To x For b = 1 To x For c = 1 To x For d = 1 To x For e = 1 To x For f = 1 To x v = Application.WorksheetFunction.Sum(a * 49, b * 99, c * 149, d * 199, e * 224, f * 249) If v = 14221 Then i = i + 1 r(i, 1) = a r(i, 2) = b r(i, 3) = c r(i, 4) = d r(i, 5) = e r(i, 6) = f r(i, 7) = a * 49 r(i, 8) = b * 99 r(i, 9) = c * 149 r(i, 10) = d * 199 r(i, 11) = e * 224 r(i, 12) = f * 249 r(i, 13) = Application.WorksheetFunction.Sum(r(i, 7), r(i, 8), r(i, 9), r(i, 10), r(i, 11), r(i, 12)) If i >= Rows.Count Then GoTo Skipper End If Next f Next e Next d Next c Next b Next a Skipper: Range("A1").Resize(i, UBound(r, 2)).Value = r Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub الكود سيستغرق وقت طويل بعض الشيء لربما يصل لأكثر من 5 دقائق لذا لا تقلق .. عدد النتائج كبير جداً .. لأن الاحتمالات كثيرة جداً جداً

أما زالت تظهر لك الرسالة حتى بعد ضبط الإعدادات ..؟ جرب تضع الكود التالي في حدث فتح المصنف Application.DisplayAlerts=False

السلام عليكم أخي الكريم ياسر تفضل الكود مع الشرح لعله يكون المطلوب إن شاء الله برجاء وضع الأكواد بين أقواس الكود لتظهر بشكل منضبط Sub Auto_open() 'فهذا يعني أن الماكرو [Auto_Open] إذا كان اسم الماكرو بهذا الاسم '[Workbook_Open] سينفذ بمجرد فتح المصنف كما هو الحال في حدث فتح المصنف '--------------------------------------------------------------------- 'تعريف المتغيرات المستخدمة في الكود Dim ws As Worksheet Dim i As Integer Dim x As Double Dim y As Double 'حلقة تكرارية لكل أوراق العمل الموجودة بالمصنف الحالي For Each ws In ThisWorkbook.Worksheets 'بدء التعامل مع ورقة العمل المعنية داخل الحلقة التكرارية With ws 'حلقة تكرارية من الصف رقم 1 إلى الصف رقم 10 For i = 1 To 10 'تعيين قيمة للمتغير ليساوي القيمة في العمود الخامس في الصف المحدد x = ws.Cells(i, 5).Value 'تعيين قيمة للمتغير ليساوي القيمة في العمود السابع في الصف المحدد y = ws.Cells(i, 7).Value 'في ورقة العمل المعنية داخل الحلقة التكرارية في العمود الثامن 'وفي الصف المحدد داخل الحلقة التكرارية للصفوف يساوي حاصل ضرب المتغيرين ws.Cells(i, 8).Value = x * y 'الانتقال للصف التالي Next i 'انتهاء التعامل مع ورقة العمل المعنية داخل الحلقة التكرارية End With 'الانتقال لورقة العمل التالية Next ws End Sub