سليم حاصبيا

تصحيح المعادلة (في C9) والسحب =IF($CM9>0,VLOOKUP($CM9,'العاملين '!$A$3:$AR$260,10,0),"")

ما هو اصدار الاكسل عندك اذا كان ما دون 2007 استبدل "xfd" في الكود بــــ "BZ"

تم التعديل على الكود لعدم نقل التكرار(ليعمل الماكرو يجب الا تكون خانة التاريخ فارغة في الورقة "حركة يومية") Sub tarheel() Dim S_Sh As Worksheet: Set S_Sh = Sheets("حركة يومية") Dim My_Sh As Worksheet Dim S_Rg As Range, rg_to_copy As Range Dim My_Item$, lr_final% Dim t%, k%: k = Sheets.Count Dim lr%: lr = S_Sh.Cells(Rows.Count, 1).End(3).Row Set S_Rg = S_Sh.Range("a1:h" & lr) Dim str$: str = "OK" For i = 4 To k Set My_Sh = Sheets(i) lr_final = My_Sh.Cells(Rows.Count, 1).End(3).Row + 1 For t = 2 To lr If S_Rg.Cells(t, 7) = My_Sh.Name Then If S_Sh.Cells(t, "xfd") <> str Then My_Sh.Cells(lr_final, 1).Resize(1, 7).Value = _ S_Sh.Cells(t, 1).Resize(1, 7).Value lr_final = lr_final + 1 S_Sh.Cells(t, "xfd") = str End If End If Next Next End Sub الملف مرفق salim's exemple.xlsm

حرب هذا الكود Sub tarheel() Dim S_Sh As Worksheet: Set S_Sh = Sheets("حركة يومية") Dim My_Sh As Worksheet Dim S_Rg As Range Dim lr_final% Dim t%, k%: k = Sheets.Count Dim lr%: lr = S_Sh.Cells(Rows.Count, 1).End(3).Row Set S_Rg = S_Sh.Range("a1:h" & lr) For i = 4 To k Set My_Sh = Sheets(i) lr_final = My_Sh.Cells(Rows.Count, 1).End(3).Row + 1 For t = 2 To lr If S_Rg.Cells(t, 7) = My_Sh.Name Then My_Sh.Cells(lr_final, 1).Resize(1, 7).Value = _ S_Sh.Cells(t, 1).Resize(1, 7).Value lr_final = lr_final + 1 End If Next Next End Sub

جرب هذا الكود Option Explicit Sub hid_rows() ' اختر هنا اي ورقة تريد '===================== Dim my_sh As Worksheet: Set my_sh = Sheets("العاملين") 'Dim my_sh As Worksheet: Set my_sh = ActiveSheet '===================== Dim My_Rg As Range Dim lr% lr = my_sh.Cells(Rows.Count, 1).End(3).Row Set My_Rg = my_sh.Range("A1:A" & lr) My_Rg.EntireRow.Hidden = False My_Rg.SpecialCells(4).EntireRow.Hidden = True End Sub

الكود الثالث يكتب هكذا Sub tahwiell() Application.Calculation = xlManual Dim FS, FR, TS, TR FS = "سند قبض" FR = "a10" TS = Sheets(FS & "").Range("A7") TR = Sheets(FS & "").Range("i26") Sheets(FS & "").Range(FR & "").Copy TS = Sheets(FS & "").Range(TR & "").PasteSpecial(Paste:=xlPasteValues) Application.Calculation = xlAutomatic ActiveSheet.EnableSelection = xlUnlockedCells End Sub

جرب هذه الملف Auto_numbering.xlsx

جرب هذه الملف Three_cdes_in One.xlsm

تم معالحة الامر ( لم افهم لماذا هذا الملف كبير جداً 34 ميغا) استبدل في الكود هذا السطر S_sh.Range("q2").Formula = "=AND($A4=$A$1&"",$B4=$B$1&"")" بهذا S_sh.Range("q2").Formula = "=AND($A4=$A$1&"""",$B4=$B$1&"""")" لان الخلايا في العامود A و B هي بتنسيق نص بينما الخلايا A1 و B1 يتنسيق ارقام التصفية salim.rar

ارفع جزر بسيط من الملف (20 صف على الاكثر)للمعالجة ومعرفة الخطأ

جرب هذا الملف تصفيةبشرطين salim.xlsm

جرب هذا الملف (الصفحة Main) الماكرو Option Base 1 '======================================= Private Sub CCMD_1_Click() sum_all_L2_in_B3 End Sub '=========================================== Sub sum_all_L2_in_B3() Dim first_sheet$: first_sheet = Sheets(1).Name Dim last_sheet$: last_sheet = Sheets(Sheets.Count - 2).Name Dim t$, last_row% last_row = Sheets("Main").Cells(Rows.Count, 2).End(3).Row If last_row < 2 Then last_row = 2 Sheets("Main").Range("b2:b" & last_row).ClearContents Dim First_row%: First_row = 2 t = "=SUM('" & first_sheet & ":" & last_sheet & "'!L" & First_row & ")" With Sheets("Main").Cells(3, "b") .Offset(-1, 0) = "the sum of L2" & Chr(10) & " from sheets " & first_sheet & " to sheet " & last_sheet .Formula = t .Value = .Value End With ' End Sub '======================================== Sub sum_all_L2_with_msgbox() Dim first_sheet$: first_sheet = Sheets(1).Name Dim last_sheet$: last_sheet = Sheets(Sheets.Count - 2).Name Dim t$, x$ t = "=SUM('" & first_sheet & ":" & last_sheet & "'!L" & 2 & ")" x = "the sum of L2" & Chr(10) & " from sheets " & first_sheet & " to sheet " & last_sheet MsgBox x & Chr(10) & Evaluate(t), vbMsgBoxRight End Sub الملف Salim's_Sum.xlsm

اذا اردت ان تجمع كل الخلايا من العامود B في كل الصفحات اليك هذا الماكرو Option Explicit Option Base 1 '======================================= Private Sub CCMD_1_Click() sum_all_rows_in_all_sheets End Sub '=========================================== Sub sum_all_rows_in_all_sheets() Dim first_sheet$: first_sheet = Sheets(3).Name Dim last_sheet$: last_sheet = Sheets(Sheets.Count - 1).Name Dim arr(), lr%, i%, My_Max%: My_Max = 0 Dim t$, last_row% last_row = Sheets("Main_sh").Cells(Rows.Count, 2).End(3).Row Sheets("Main_sh").Range("b3:b" & last_row).ClearContents Dim First_row%: First_row = 4 For i = 3 To Sheets.Count - 1 lr = Sheets(i).Cells(Rows.Count, 2).End(3).Row If lr < 3 Then lr = 3 ReDim Preserve arr(i - 2): arr(i - 2) = lr Next For i = LBound(arr) To UBound(arr) If My_Max < arr(i) Then My_Max = arr(i) Next t = "=SUM(" & first_sheet & ":" & last_sheet & "!B" & First_row & ")" With Sheets("Main_sh").Cells(3, "b").Resize(My_Max - 3, 1) .Formula = t .Value = .Value End With End Sub '======================================== الملف مرفق تجميع قيم salim 2.xlsm

تفضل الملف مع المعادلة (الاصح) =CHOOSE((MOD(SUM(A3:C3)/3,1)>=0.5)+1,FLOOR(SUM(A3:C3)/3,0.5),CEILING(SUM(A3:C3)/3,0.5)) الملف book_salim.xlsx

ممكن هذه المعادلة تفي بالغرض =CHOOSE((A1<=B1)+1,PRODUCT(C1,D1),1000)

تم معالجة الامر تصحيح Salim.xlsm

جرب هذه المعادلة واسحب نزولاً =IF(MOD(SUM(A3:C3)/3,1)<>0,INT(SUM(A3:C3)/3)+1,SUM(A3:C3)/3)

تم تعديل الماكرو ليعمل في جميع الظروف حتى ولو تم تغيير اسماء الصفحات من 1و2و3 الى ما تريد من اسماء شرط اضافة الشيتات بين الصفحتين "تجميع " و "طباعة" Option Explicit Private Sub Worksheet_Activate() Dim t Dim first_sheet$: first_sheet = Sheets(3).Name Dim last_sheet$: last_sheet = Sheets(Sheets.Count - 1).Name ActiveSheet.Range("b3:b1000").ClearContents t = "=SUM(" & first_sheet & ":" & last_sheet & "!B4)" With Cells(3, "b").Resize(Sheets.Count - 3, 1) .Formula = t .Value = .Value End With End Sub الملف مع تغيير اسماء الشيتات تجميع قيم salim 1.xlsm

جرب هذا الماكرو (يكفي ان تخرج من الصفحة ثم تعود اليها لتجد النتيبجة قد سبقتك الى مكانها الصحيح) اضافة الصفحات يجب ان يكون بعد صفحة "تجميع" و قبل صفحة "طباعة" وذلك كي يعمل الكود بشكل جيد Private Sub Worksheet_Activate() Cells(3, "b").Resize(Sheets.Count - 3, 1).Formula = _ "=SUM('1:" & Sheets.Count - 3 & "'!B4)" Cells(3, "b").Resize(Sheets.Count - 3, 1).Value = _ Cells(3, "b").Resize(Sheets.Count - 3, 1).Value End Sub الملف مرفق تجميع قيم salim.xlsm

اخي محمد الملف كبير جداً (اكثر من 2 ميغا)و التعامل معه مضيعة للوقت لذلك ارفق تموذجاً صغيراً عن الملف (حوالي 20 ضف) لكتابة الكود اللازم

حرب هذا الملف الكود Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False Dim lr As Long If Target.Column = 1 And Target.Cells.Count = 1 Then lr = Cells(Rows.Count, 1).End(3).Row Range("a1:a" & lr).SortSpecial End If Application.EnableEvents = True End Sub الملف مرفق autu_sort.xlsm

زرنامة تدرج كل التواريخ بين تاريخين (من اختيارك) مفصلة حسب كل شهر في عامود مع حرية حذف يوم او يومين او ثلاثة ايام (من اختيارك ايضاً) او عدم حذف اي يوم Date_without_days_by_colums_and_month2.xlsm

جرب هذا الملف dATE_IF.xlsx

تم معالجة الامر Booksalim.xlsx

تم معالجة الامر انظر الى الصفحة New_Sheet من هذا الملف الباسورد 500 Salim 2018 With_combo.xlsm