سليم حاصبيا

اذا كنت ما فهمته صجيجاً المطلوب هذا الشيء MM.xlsx

طلب مني احد الأصدقاء مجموعة أرقام عشوائية بدون تكرار و محصورة بين عددين مثلا 20 رقم بين 50 و 100 فتم وضع هذا الملف الذي ربما يكون له فائدة املأ الخلايا E2 و F2 و G2 بالأعداد المطلوبة و اضغط الزر الكود يقوم باحتيار الأرقام المطلوبة ب 3 طرق ترتيب تصاعدي / ترتيب تنازلي / ترتيب عشوائي """"""""""""""""""""""""""""""""""""""""""""""""""""""""""""" يمكن استعماله في اللوتو اللبناني مثلاً ( 6 أرقام بين 1 و 42) الحد الادنى 1 قي E2 / الحد الأفصىى 42 في F2 / العدد المطلوب 6 أرقام في G2 Rand_between_without_rept.xlsm

ألملف بواسطة الماكرو Option Explicit Sub Repeat_by_choise() Dim i%, K%, lr%, m%, Mot$ Mot = "النتيجه المطلوبه" With Sheets("ورقة1") .Range("k1").CurrentRegion.ClearContents .Range("k1") = Mot lr = .Cells(Rows.Count, 1).End(3).Row K = IIf(Val(.Cells(2, 3)) <= 0, 2, Int(.Cells(2, 3))) .Cells(2, 3) = K m = 2 For i = 2 To lr .Cells(m, "K").Resize(K).Value = _ .Cells(i, 1).Value m = m + K Next End With End Sub Repeat _by_choise.xlsm

مشكور استاذ علي على هذه المغادلة لكن انت تعرفني اني لا أحب دالة IFERROR ولا استعملها الا في الحالات الضرورية حيث لا مفر منها لانها تجبر البرنامج على حساب المعادلة واذا كان هناك حطأ يضع فراغ (هذا شيء شرحته في مشاركات سابقة عديدة) لذلك اقترح هذا المعالة في العامود H مثلاً الخلية 2 : =IF(ROWS($H$2:H2)>$C$2*COUNTA($A$2:$A$100),"",INDEX($A$2:$A$100,MATCH(FALSE, COUNTIF($H$1:H1,$A$2:$A$100)=$C$2,0))) الملف مرفق Repeat _by_choise.xlsx

جرب هذا الملف Option Explicit Sub Sort_me(ByVal rag As Range, ByVal col As Integer, Ad As Integer) rag.Sort key1:=rag.Cells(1, col), order1:=Ad, Header:=1 End Sub '+++++++++++++++++++++++++++++++++++++++ Private Sub ToggleButton1_Click() Dim My_col If (Selection.Address(0, 0) = "A1" Or _ Selection.Address(0, 0) = "B1" Or _ Selection.Address(0, 0) = "C1") And _ Selection.Count = 1 Then My_col = Selection.Cells(1, 1).Column If ToggleButton1 = True Then Call Sort_me(Selection.CurrentRegion, My_col, 2) ToggleButton1.Caption = "تنازلي حسب خلية " & Cells(1, My_col) Else Call Sort_me(Selection.CurrentRegion, My_col, 1) ToggleButton1.Caption = "تصاعدي حسب خلية " & Cells(1, My_col) End If Else Exit Sub End If End Sub الملف مرفق commendos_sort.xlsm

حضرتك عضو في المنتدى منذ 2011 من المفروض ان تعرف اصول المشاركات فمن سيقوم بانشاء ملف لك يحتوي عما تريد و يدرج المعادلات اللازمة و ربما الملف صحيحاً وفي أغلب الاحيان لا (حيث لا أحد يعرف مكان البيانات "في اي نطاق" عندك و حجمها ) المفروض رفع ملف مختصر عما تريد من 5- 10 اسطر

وتقول مشكلة بسيطه جدا جدا واجهتني و قد اخذت من الوقت الكثير لحلها تم حماية الخلايا D2 و F2 لانها تتغير أوتوماتيكاً كلما عدلت على الفروع أو تعديل على عدد الشاشات ولا ضرورة لتغييرها يدوياً Asd_2000_2 .xlsx

تم معالجة الأمر Asd_2000_1.xlsx

كبف سيكون لكل فرع 5 شاشات ونصف الشّاشة (من أين اتيت بالـــ 5.5) ز هل يمكن ان يكون هناك ربع شاشو او 0.1 من الشاشة على كل حال يمكن تعديل المعادلة الى

القائمة المنسدلة في ُE2 وليس E3 خيث اللون الأصفر عندك

يجب استبدال الرفم 1 الذي هو رقم العامود " ِA " في هذا السطر الى رقم العامود M اي (13) او استبداله الى "M" ro = Sh.Cells(Rows.Count, "M").End(3).Row و كذلك هنا If .Cells(i, "M") <> vbNullString And _ Not col.Contains(.Cells(i, "M").Value) Then col.Add .Cells(i, "M").Value

جرب هذا الشيء Asd_2000.xlsx

يجب تحرير السطر بهذا الشكل With .Range("E2:E50").Validation

جرب هذا الملف Option Explicit Dim col As Object Dim ro%, i% Dim Sh As Worksheet '++++++++++++++++++++++++++++++++++ Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Not Intersect(Target, Range("a:a")) Is Nothing _ And Target.Count = 1 Then data_val Cells(2, "F") = Target End If Application.EnableEvents = True End Sub '+++++++++++++++++++++++++++++++++++++++++ Sub data_val() Set Sh = Sheets("Sheet1") ro = Sh.Cells(Rows.Count, 1).End(3).Row Set col = CreateObject("System.Collections.Arraylist") With Sh For i = 2 To ro If .Cells(i, 1) <> vbNullString And _ Not col.Contains(.Cells(i, 1).Value) Then col.Add .Cells(i, 1).Value End If Next i With .Cells(2, "F").Validation .Delete: .Add 3, Formula1:=Join(col.toarray, ",") End With End With End Sub الملف مرفق Abou_hasn_validation.xlsm

كيف لي أن ابحث في جدول فارغ تماماً من البيانات حتى رؤوس الأعمدة غير موحودة

بعد اذن صديقي الرائد هذا الماكرو وزيادة في اثراء الموضوع (كود من سطر واحد) Option Explicit Private Sub UserForm_Initialize() Me.ComboBox1.List = _ Application.Transpose _ ([index(text(date(1,row(1:12),1),"[$-801]mmmm"),)]) End Sub أو اذا كنت تريده على الشيت Sub fill_combo() Sheets("sheet1").OLEObjects("My_Combo").Object.List = _ [index(text(date(1,row(1:12),1),"[$-801]mmmm"),)] End Sub الملف مرفق Month_series_For_Userform.xlsm

جرب هذه المعادلة =IF(ISERROR(MATCH(E4,{8;9;16;18},0)),"خطأ","صح") sooos.xlsx

المعادلات المطلوبة (تسحب نزولاً قدر ما تريد عندها يختفي كل شيء من الصفر وما دون) المعادلة الصحيحة في ِA4 =CHOOSE((SUM(A3,-$D$2)<=0)+1,SUM(A3,-$D$2),"") المعادلة الصحيحة في B4 =CHOOSE((A4="")+1,SUM(B3,F$2),"") المعادلة الصحيحة في C3 =CHOOSE(OR(A3="",B3="")+1,A3*B3,"") المعادلة الصحيحة في E2 =SUM(C3:C1500) الملف مرفق Market abo azzam.xlsx

جرب هذا الملف Option Explicit Sub Get_Str() Dim My_Sheet As Worksheet Dim My_Regex As Object Dim K As Byte, La%, t%, st$ Set My_Sheet = Sheets("Sheet1") Set My_Regex = CreateObject("VBScript.RegExp") My_Regex.Global = True With My_Sheet La = .Cells(Rows.Count, 1).End(3).Row .Range("C2").CurrentRegion.ClearContents For K = 3 To 4 My_Regex.Pattern = _ IIf(K = 4, "[\u0621-\u064A]+", "\w+") For t = 1 To La If My_Regex.test(.Range("A" & t)) Then st = My_Regex.Replace(.Range("A" & t), "") .Cells(t, K) = Trim(st) End If Next t st = "" Next K End With Set My_Regex = Nothing End Sub الملف مرفق ReGex_Kaddour_1.xlsm

تم معالجة الأمر (بدون عامل القسمة) ABO_AZz NEW.xlsx

تالموضوع يتعلق بقسمة العددين (قسمة هذين العددين تطعي عدد الصفوف المطلوبة) مثلاُ 25 قسمة تعطي 12.5 ولا يوجد 12 صف ونصف الصف اما الموضع الثاني ارفع الملف للمعاينة مع شرح المطلوب

بعد اذن أخي الرائد هذا الكود في نفس الصفحة ("البيانات") حدد كم صفاً تريد للطباعة على ورقة واحدة من الخلية H1 و اضغط الزر ثم اذهب الى معاينة قبل الطباعة لتجد المطلوب Option Explicit Sub Page_Break() Dim B As Worksheet Dim LA%, x%, Ho_many% Dim Rg_a As Range Set B = Sheets("البيانات") If Val(B.Range("H1")) <= 4 Then Ho_many = 4 Else Ho_many = Int(B.Range("H1")) End If B.Range("h1") = Ho_many LA = B.Range("A1").CurrentRegion.Rows.Count ActiveSheet.ResetAllPageBreaks For x = Ho_many + 6 To LA Step Ho_many B.HPageBreaks.Add Before:=B.Range("A" & x) Next End Sub الملف مرفق Insert_H_Breaks.xlsm

لا حاجة للكود اضغط سهم يمين أو يسار تنتقل الى حيثما تريد

معادلة اخرى (معقدة قليلاَ) في العامود I تقوم ابضاَ بالمطلوب ABO_AZ NEW_2.xlsx

تم التعديل على المعادلات جسب ما تريد ABO_AZ NEW_1.xlsx