بحث مخصص من جوجل فى أوفيسنا
Custom Search

سليم حاصبيا

أوفيسنا
  • Content count

    3,690
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    54

سليم حاصبيا last won the day on March 8

سليم حاصبيا had the most liked content!

السمعه بالموقع

2,375 Excellent

عن العضو سليم حاصبيا

  • الرتبه
    مشرف
  • تاريخ الميلاد 08 مار, 1985

Profile Information

  • Job Title
    استاذ ثانوي

اخر الزوار

2,851 زياره للملف الشخصي
  1. استبدل الكود بهذا Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 4 Then _ ActiveWindow.Zoom = 120 Else _ ActiveWindow.Zoom = 80 End Sub
  2. الماكرو يقوم بنقل البيانات تم يرتبها حسب المطلوب التعديل في الورقة الاولى و ينقل مباشرة الى باقي الاوراق يمجرد الضغط على الزر Transfere Data with sort.rar
  3. جرب هذا الكود مبدئياً التعديل في الورقة الاولى و ينقل مباشرة الى باقي الاوراق يمجرد الضفط على الزر تم تصحيح الخطأ Transfere Data.rar
  4. جرب هذا الملف تختار المجلد المناسب و ترى محتوياته و عندما تضغط على اي ملف من المحتويات يفتح الملف المذكور listfiles.rar
  5. جرب هذا الملف اكتب الصفوف من الى في الخلايا B&A Hide_rows.rar
  6. تمت معالجة الامر بناء على امرين 1-عدد الايام الفعلية بغض النظر عن تاريخ البداية والنهاية 2-عدد الايام الفعلية مع الاخذ بالحسبان تاريخ البداية والنهاية لا اعلم ايهما مناسب لك بالنسبة لعدد الزيارات لم افهم المطلوب 1تجربة salim.rar
  7. بكا تأكيد يمكنك فعل ذلك
  8. الملف مع المعادلة salimالتاريخ الافتراضي.rar
  9. تلزم هذه المعادلة =IF(A1="","",A1)
  10. جرب هذه المعادلات دالة الوقت - طرح و جمعsalim.rar
  11. امسح محتويات العامود S كاملة اضف هذا السطر الى الكود مباشرة بعد عبارة :Exitsub على سطر مستقل ثم تفذ الماكرو S_sh.Range("s:s").Clear
  12. تم معالجة الامر مع المجاميع و زيادة حبتين قائمة حساب salim with summution.rar الماكرو المطلوب Option Explicit Sub filter_me() Dim S_sh, T_sh As Worksheet Dim My_rg As Range Dim T2, T3, T4 As String Dim VaL2, VaL3, VaL4, x, y, Z As Double Dim Lrs, Lrss, LrSalim As Long Dim m, k, i As Integer If ActiveSheet.Name <> "Salim" Then GoTo ExitSub Application.ScreenUpdating = False Application.Calculation = xlCalculationManual On Error GoTo ExitSub Set S_sh = Sheets("Data"): Set T_sh = Sheets("Salim") Lrs = S_sh.Cells(Rows.Count, "e").End(3).Row T_sh.Range("a1:H150000").Clear Range("e2:e" & Lrs).Copy Range("S1") Range("s1:s" & Lrs).RemoveDuplicates Columns:=1, Header:=xlNo Lrss = S_sh.Cells(Rows.Count, "s").End(3).Row m = 1 For i = 1 To Lrss T_sh.Range("j2").Formula = "=Data!E2=Data!$S$" & i Sheets("Data").Range("A1:H" & Lrs).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("J1:J2"), CopyToRange:=Range("A" & m), Unique:=False m = m + Application.CountIf(S_sh.Range("e2:e" & Lrs), S_sh.Range("s" & i)) + 2 Next LrSalim = T_sh.Cells(Rows.Count, "g").End(3).Row Set My_rg = T_sh.Range("g2:g" & LrSalim).SpecialCells(2, 1) For k = 1 To My_rg.Areas.Count My_rg.Areas(k).Select '====================================== On Error Resume Next With My_rg.Areas(k) x = .Cells(1).Row y = .Rows.Count Z = x + y T2 = "SUMIFS($G$" & x & ":$G$" & Z - 1 & ",$H$" & x & ":$H$" & Z - 1 & "," & "$M$2" & ")*VLOOKUP($M$2,$M$2:$N$4,2,0)" T3 = "SUMIFS($G$" & x & ":$G$" & Z - 1 & ",$H$" & x & ":$H$" & Z - 1 & "," & "$M$3" & ")*VLOOKUP($M$3,$M$2:$N$4,2,0)" T4 = "SUMIFS($G$" & x & ":$G$" & Z - 1 & ",$H$" & x & ":$H$" & Z - 1 & "," & "$M$4" & ")*VLOOKUP($M$4,$M$2:$N$4,2,0)" If Not (IsEmpty(Evaluate(T2))) Then VaL2 = Evaluate(T2) Else VaL2 = 0 If Not (IsEmpty(Evaluate(T3))) Then VaL3 = Evaluate(T3) Else VaL3 = 0 If Not (IsEmpty(Evaluate(T4))) Then VaL4 = Evaluate(T4) Else VaL4 = 0 Cells(Z, "g") = VaL2 + VaL3 + VaL4 Cells(Z, "H") = "Sum:" End With Next Cells(LrSalim + 1, "d") = "Total Sum:": Cells(LrSalim + 1, "d").Interior.ColorIndex = 35 Cells(LrSalim + 1, "c").Formula = "=SUMPRODUCT(--($E$2:$E$100000=""""),$G$2:$G$100000)" Cells(LrSalim + 1, "c").Interior.ColorIndex = 35 ExitSub: Range("a1").Select Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub
  13. استعمل مؤقتاً الماكرو الموجود في المشاركة الاولى (مع تعديل عدد الصفوف من 500 الى 150000) قائمة حساب salim.rar ريثما نجد حلاً للمجاميع
  14. لازالة الحماية عن الورقة اضغط على الزر Alt باستمرار ثم الثلاثة ازار بالتتابع R ثم P ثم S ثم OK نفس العملية لاعادة الحماية ملاحظة مهمة:لغة لوحة المفاتيح يجب ان تكون اجنبية
  15. تم التعدبل على الملف للحصول على المجاميع قائمة حساب salim with sum.rar الكود مرفق Sub filter_me() Dim S_sh, T_sh As Worksheet Dim X, Y, Z As Long Dim LRSS, LRS, M As Integer Dim T1, T2, T3 As String Set S_sh = Sheets("Data"): Set T_sh = Sheets("Salim") LRS = S_sh.Cells(Rows.Count, "e").End(3).Row T_sh.Range("a1:H500").Clear Range("e2:e" & LRS).Copy Range("S1") Range("s1:s" & LRS).RemoveDuplicates Columns:=1, Header:=xlNo LRSS = S_sh.Cells(Rows.Count, "s").End(3).Row M = 1 For i = 1 To LRSS T_sh.Range("j2").Formula = "=Data!E2=Data!$S$" & i Sheets("Data").Range("A1:H" & LRS).AdvancedFilter Action:=xlFilterCopy, _ CriteriaRange:=Range("J1:J2"), CopyToRange:=Range("A" & M), Unique:=False On Error Resume Next M = M + Application.CountIf(S_sh.Range("e2:e" & LRS), S_sh.Range("s" & i)) + 2 T1 = "=G" & M - 4 & "*VLOOKUP(H" & M - 4 & ",$M$2:$N$4,2,0)" If IsNumeric(Evaluate(T1)) Then X = Evaluate(T1) Else X = 0 T2 = "=G" & M - 3 & "*VLOOKUP(H" & M - 3 & ",$M$2:$N$4,2,0)" If IsNumeric(Evaluate(T2)) Then Y = Evaluate(T2) Else Y = 0 T3 = "=G" & M - 2 & "*VLOOKUP(H" & M - 2 & ",$M$2:$N$4,2,0)" If IsNumeric(Evaluate(T3)) Then Z = Evaluate(T3) Else Z = 0 Cells(M - 1, 8) = "The sum:" Cells(M - 1, 7) = X + Y + Z Next S_sh.Range("s:s").Clear End Sub