سليم حاصبيا

جرب هذا الكود

بعد اذن اخي ابو عبد الباري هذا الملف Book2-2017 salim.rar

جرب هذه المعادلة قي الخلية C6 واسحب نزولاً =IF(AND(B6<>"",(COUNTIF($B$6:B6,B6)=1)),VLOOKUP(B6,Sheet1!$B$6:$C$10,2,0),"") يمكن ان يكون الحل هنا Numbers salim.rar

جرب هذه المعادلة قي الخلية C6 واسحب نزولاً =IF(AND(B6<>"",(COUNTIF($B$6:B6,B6)=1)),VLOOKUP(B6,Sheet1!$B$6:$C$10,2,0),"")

جرب هذا الماكرو (تستبدل اسم اخر شيت الى Repport لحسن التعامل مع اللغة الاجنبية) جرب هذا الماكرو Sub Give_Me_Sum() 'Author Salim 18/02/2017 Officena Dim my_rg As Range Dim lr, lrF, lrK, k, i As Integer, s, My_NUm, Oldval As Long With Sheets("Repport") lrF = .Cells(Rows.Count, "f").End(3).Row Set my_rg = .Range("f2:f" & lrF) .Range("G2:I" & lrF + 1).ClearContents .Cells(lrF + 1, "h") = "المجموع" .Cells(lrF + 1, "i") = 0 End With For i = 2 To lrF My_NUm = my_rg.Cells(i - 1) For k = 1 To Sheets.Count - 1 With Sheets(k) lrK = .Cells(Rows.Count, "e").End(3).Row For y = 5 To lrK If .Range("e" & y) = My_NUm Then _ s = s + .Range("e" & y).Offset(0, 1) Next End With Next my_rg.Cells(i - 1).Offset(0, 1) = s Oldval = Sheets("Repport").Cells(lrF + 1, "i") Sheets("Repport").Cells(lrF + 1, "i") = Oldval + s s = 0 Next End Sub

جرب هذا الملف النموذج ويمكن تعديل الكود حسب الحاجة dictionary.rar

يجب تسجيل الماكرو في حدث الصفحة 1-افتح ملف الاكسل المطلوب 2-اضغط Alt+F11 3-دوبل كليك على اسم الورقة المطلوب ادراج الماكرو فيها 4-انسخ الماكرو

جرب هذا الماكرو Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Row <> 709 Or Target.Count > 1 Then Exit Sub Rows(709).Interior.ColorIndex = xlNo If Target.Value Like "*رصيد بداية*" Then If Target.Column = 1 Then Target.Resize(1, 2).Interior.ColorIndex = 40 Else Target.Offset(0, -1).Resize(1, 3).Interior.ColorIndex = 40 End If End If End Sub

انسخ هذا الكود الى حدث الورقة Private Sub Worksheet_Change(ByVal Target As Range) Target.Columns.AutoFit End Sub

=DAY(EOMONTH(A1,0)) جرب هذه المعادلة في الخلية C1 تنسيق الخلية "General"

جرب هذا الماكرو الخفيف Sub reset_all_values() ActiveSheet.Cells.Value = ActiveSheet.Cells.Value End Sub

الملف المرفوع مصاب بفيروس و قد رفض الجهاز فتحه اليك هذا النموذج الذي بمكنك تعديل الكود فيه بما يناسبك عند الضفط على الزر Click_Me تظهر لك رسالة تطلب تحديد عدد الصفوف المطلوب Page_Break.rar

قم بتعديل كل المعادلات و ذلك باستيدال الرقم 100 ب5000 وسحبها الى الصف 5000 (مع مراعاة معادلات الصفبف التي يلزمها Ctl+Shift Enter) و في formula 1 ايضاً لكن هذا يبطأ العمل كثيراً (جيث يصبح المصنف يحتوي على اكثر من 50,000 معادلة)

بعد أذن الاخ ابو عبد الباري هذه المعادلة (استعملها مع Ctrl+Shift+Enter) =IF(OR($C3={"اداري";"فني";"عامل";"عقد"}),VLOOKUP($Q3,{0,0;400,0.15},2),VLOOKUP($Q3,{0,0.1;300,0.15;500,0.2},2))

تفضل الملف جاهز نسب مندوبين التحصيل salim.rar

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

جرب هذه المعادلة قي الخلية I2 وسحب نزولاً =IF(H2="","",VLOOKUP(H2,{1,0.04;46,0.025;76,0.01;91,0},2))

تم التعديل على الملف كما تشاء القائمة المنسدلة مطاطة تستجيب لاي تغيير قي البيانات ولا تذكر المكرر الا مرة واحدة market Salim advanced.rar

جرب هذا الكود Sub replace_for_me1() Dim my_arr() Dim my_st, my_text As String Dim my_aar2() Dim k, x, lr As Integer lr = Sheets("sheet1").Cells(Rows.Count, 1).End(3).Row For k = 2 To lr ReDim my_arr2(1 To 7) my_arr = Array("X", "Y", "Z", "A", "B", "C", "D") my_st = Range("a" & k) For i = 1 To 7 s = Mid(my_st, i, 1) If s = "0" Then my_arr(i - 1) = s: GoTo 1 my_arr2(i) = my_arr(i - 1) 1: Next my_text = "" For x = LBound(my_arr) To UBound(my_arr) my_text = my_text & my_arr(x) Next Range("a" & k).Offset(0, 2) = my_text Next End Sub

ربما كان المطلوب احصائية SALIM.rar

حرب هذه المعادلة =IF(OR(A2="",C2=""),"",A2-(C2*18))

جرب هذا الماكرو (تستبدل اسم اخر شيت الى Repport لحسن التعامل مع اللغة الاجنبية) مرفق الملف Sub copy_spcial_cells() Dim Ws_Source As Worksheet Dim My_Sheet As Worksheet Dim My_NUm, x, s, lr, k, i As Integer Dim My_Rg As Range Set Ws_Source = Sheets("Repport") With Ws_Source .Select .Range("a4:d1000").ClearContents My_NUm = .Range("b1") End With x = 4 k = Sheets.Count For i = 1 To k - 1 Set My_Sheet = Sheets(i) lr = My_Sheet.Cells(Rows.Count, "e").End(3).Row If lr < 5 Then lr = 5 For s = 5 To lr If Sheets(i).Range("E" & s) = My_NUm Then With Ws_Source .Range("a" & x) = My_Sheet.Range("b1") .Range("b" & x) = My_Sheet.Range("b2") .Range("c" & x) = My_Sheet.Range("b" & s) .Range("d" & x) = My_Sheet.Range("a" & s) End With x = x + 1 End If Next Next End Sub Report salim.rar

تم معالجة الامر market Salim.rar

جرب هذا الملف العامود الاخضر تعديل معادلة sa;im.rar