سليم حاصبيا

المعادلات تقوم بهذا الشيء انظر الى هذا الملف /لقد اضفت عميلين (Officena & Salim) تم تسجيلهما في القائمة المنسدلة أوتوماتيكياً و يتم ادراج سجلاتهم بمجرد اظهار الاسم في القائمة المنسدلة يمكنك تجربة ذلك باضافة عملاء جدد مع بياناتهم ................... تسجيل البيانات يتم في الصفحة customer_account_sub_dollarg(الترتيب ليس مهماً) و اظهارها في الصقحة Salim للحضول الى ادراج الاسماء بدون تكرار انظر الى المعادلات في العمود XEZ و للحصول على القائمة المنسدلة تستعمل المعادلة في الخلية ْXFA1 Book salim_1.rar

ريما يكون المطلوب ترتيب حسب تاريخ الميلاد salim.rar

ارفع جزء بسيط من الملف (حوالي 20 سطر) للعمل عليه

جرب هذا الملف الصفحة "Salim" Book salim.rar

انسخ هذه المعادلة الى الخلية ِA2 و اسحب نزولاً =IF(B2="","",COUNTIF($B$2:B2,B2))

يمكن استبدال = باشارة =<

جرب هذا الكود Private Sub CommandButton1_Click() Dim ws As Worksheet, lr%, i%, s#, p# Set ws = ThisWorkbook.Sheets("sale") Dim Const_Time lr = ws.Cells(Rows.Count, 1).End(3).Row Const_Time = CDate("11:00:00") For i = 1 To lr If Range("f" & i) = Const_Time Then Exit For End If Next For k = i To lr p = Range("c" & k) * Range("b" & k) s = s + p Next Me.TextBox1 = s Me.TextBox1.Font.Size = 14 End Sub

ربما يكون المطلوب Classeur2 salim.rar

جرب هذا الماكرو Option Explicit Sub Fill_Data() If ActiveSheet.Name <> "Sheet1" Then Exit Sub Dim My_rg As Range Dim i% Set My_rg = Range("a1").CurrentRegion.Offset(1) My_rg.Columns(2) = vbNullString For i = 1 To My_rg.Rows.Count - 1 If My_rg.Cells(i, 1) = My_rg.Cells(i, 3) Then My_rg.Cells(i, 2) = My_rg.Cells(i, 4) End If Next End Sub

ملف وهمي يكون مشابهاً (20-25 سطر)

ارفع ملفاً للتعامل معه

ارفع الملف وليس صورة عته لانه لا يمكن التعامل مع الصورة(كلمة السر)

جرب هذا الملف Insert_rows.rar

هذه المعادلة تفي بالغرض =IF($B2="","",SUMPRODUCT(--(ورقة1!$B$2:$B$100=$B2),ورقة1!$C$2:$C$100,ورقة1!$D$2:$D$100)/SUMPRODUCT(--(ورقة1!$B$2:$B$100=$B2),ورقة1!$C$2:$C$100))

اكسل يفعل لك اوتوماتيكياً

الكود Option Explicit Sub Give_Std() If ActiveSheet.Name <> "قوائم الفصول " Then GoTo 1 With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With Dim Source_Sh As Worksheet, Tar_Sh As Worksheet Dim Source_Lr% Dim My_Str As String Dim R%, C%, i%, t%, m% Set Source_Sh = Sheets("الأسماء"): Set Tar_Sh = Sheets("قوائم الفصول ") Source_Lr = Source_Sh.Cells(Rows.Count, 1).End(3).Row If Source_Lr < 5 Then Source_Lr = 5 My_Str = Tar_Sh.Range("G5") Tar_Sh.Range("b7:k41").ClearContents R = 7: t = 6 For i = 5 To Source_Lr If Source_Sh.Range("c" & i) = My_Str Then t = t + 1 If t <= 41 Then Tar_Sh.Range("b" & R).Resize(1, 5).Value = Source_Sh.Range("a" & i).Resize(1, 5).Value R = R + 1 Else R = 7 + m Tar_Sh.Range("G" & R).Resize(1, 5).Value = Source_Sh.Range("a" & i).Resize(1, 5).Value m = m + 1 End If End If Next 1: With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With End Sub الملف قوائم salim.rar

جرب هذا الماكرو Option Explicit Sub Transform_Array() Dim First_Sh As Worksheet, Sec_Sh As Worksheet Set First_Sh = Sheets("فاتوره"): Set Sec_Sh = Sheets("اضافه") Dim t%, x%, i% t = Application.CountIf(Sec_Sh.Range("b:b"), First_Sh.Range("D3")) If t <> 0 Then MsgBox "هذا الرقم (الاضافة) موجود الرجاء استبداله": Exit Sub With Sec_Sh x = Application.Max(First_Sh.Range("b8:b27")) i = .Cells(Rows.Count, "f").End(3).Row + 1 '================================ With .Range("b" & i) .Offset(, 0) = First_Sh.Range("d3") .Offset(, 1) = First_Sh.Range("d4") .Offset(, 2) = First_Sh.Range("d5") .Offset(, 3) = First_Sh.Range("g3") .Offset(1, 3).Resize(x, 6).Value = First_Sh.Range("c8").Resize(x, 6).Value End With End With End Sub الملف مرفق asd salim.rar

كل هذه الاسماء في صف واحد؟؟؟ (و ما هو هذا الصف الاول.... الثاني ...السادس) و كيف نعرف ذلك

انت لم تطلب ذلك ارفق ملفاً فية بيانات مكتوبة عن كل فصل(حوالي 10اسطر في كل قصل)

الملف مرفق قوائم salim.rar

انسخ هذه المعادلة الى الخلية F5 و يتم التبديل من الخلية L8 =VLOOKUP($L$8,{1,"الصف الاول";2,"الصف الثاني ";3,"الصف الثالث";4,"الصف الرابع";5,"الصف الخامس";6,"الصف السادس"},2,0)

تم تعديل الكود (يجب وضعه في حذث الصفحة و ليس في موديل مستقل) Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim C%, My_Rg As Range Application.EnableEvents = False Application.ScreenUpdating = False Application.Calculation = xlCalculationManual C = ActiveSheet.Cells(3, Columns.Count).End(1).Column Set My_Rg = Range("a3").Resize(500, C) If Intersect(Target, My_Rg) Is Nothing Then GoTo 1 My_Rg.Rows(1).Interior.ColorIndex = 0 Cells(3, Target.Column).Interior.ColorIndex = 36 1: Application.EnableEvents = True Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub الملف مرفق Talween.rar

جرب هذا الماكرو Option Explicit Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim C%, R% Dim My_Rg As Range Application.EnableEvents = False Application.ScreenUpdating = False Application.Calculation = xlCalculationManual C = ActiveSheet.Cells(3, Columns.Count).End(1).Column R = ActiveSheet.Cells(Rows.Count, 1).End(3).Row + 2 Set My_Rg = Range("a3").Resize(R - 2, C) If Intersect(Target, My_Rg) Is Nothing Then GoTo 1 My_Rg.Interior.ColorIndex = 0 My_Rg.Columns(Target.Column).Interior.ColorIndex = 36 1: Application.EnableEvents = True Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub الملف مرفق تظليل salim.rar

جرب هذا الملف salim.rar

جرب هذا الملف tabdil.rar