اعلن هنا
أكاديمية الصقر للتدريب
أعلن هنا
أعلن هنا
صفحتنا على الفيس بوك
أعلن هنا



أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





ترتيب البيانات وفقا لاجمالى الارصدة

السلام عليكم ورحمة الله وبركاته اليوم اقدم لكم معادلة مرنة للتعامل مع البيانات وفقا للارصدة الخاصة بها المعادلة تم انشا ..



28-08-2018 10:11 مساء
Eslam Abdullah
menu_open
مشرف على لغات برمجة آخرى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1150
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
الدعوات : 2
يتابعهم : 3
يتابعونه : 55
قوة السمعة : 6888
الاعجاب : 1942
 offline 

السلام عليكم ورحمة الله وبركاته

اليوم اقدم لكم معادلة مرنة للتعامل مع البيانات وفقا للارصدة الخاصة بها
المعادلة تم انشائها من فترة
عند تساؤل احدهم على احدى الجروبات
عن معادلة لترتيب ارقام الموبايل تصاعديا وفقا لاجمالى زمن كل منهم


وكنت قد رايت حلول ومحاولات عدة "بالمعادلات" من الكثير الا ان جميعها ليست بالحل العملى ابدا
لذلك قمت بانشاء معادلة لهذا الغرض وايضا لتساعدكم اكثر وتمدكم بافكار عدة
بالطبع الامر ايسر بال
VBA لكنى اعرض الفكره لغرض افادتكم اكثر فيما يتعلق بالمعادلات

والان نعرض مثال بارقام موبايل وازمنتها والنتيجة المتوقعة لها

الحل الاول بطريقة غير مباشرة وهى التى افضلها شخصيا

NDUyNDg5MQ2626002
المعادلة المستخدمة بالخلية D2 (هنا يجب الضغط على Ctrl + Shift + Enter)
=IFERROR(INDEX($A$2:$A$12,SMALL(IFERROR(IF(MATCH($A$2:$A$12,$A$2:$A$12,0)=ROW(INDIRECT("1:"&ROWS($A$2:$A$12))),MATCH($A$2:$A$12,$A$2:$A$12,0),""),""),ROW()-1)),"")

المعادلة المستخدمة بالخلية E2
=SUMIF($A$2:$A$12,D2,$B$2:$B$12)

المعادلة المستخدمة بالخلية F2 (هنا يجب الضغط على Ctrl + Shift + Enter)
=INDEX($D$2:$D$12,SMALL(IF(LARGE($E$2:$E$12,ROW()-1)=$E$2:$E$12,ROW($E$2:$E$12)-1),SUM(--(LARGE($E$2:$E$12,ROW()-1)=LARGE($E$2:$E$12,ROW(INDIRECT("1:"&ROWS($E$2:E2))))))))

كما نلاحظ اولا تم استخراج الارقام الفريدة ومن ثم مجموع المدة الزمنية لهم وبعدها قمت بترتيب الارقام وفق المدة الزمنية
وانا افضلها هكذا لتقديم النتائج بشئ اكثر من التفصيل وتقليل حجم التعامل مع صيغ الصفيف الطويلة وبالتالى سرعة اكبر فى النتائج

والحل بالطريقة المباشرة ان تكون كالتالى

NDcyMjQzMQ9292003
المعادلة المستخدمة بالخلية D2 (هنا يجب الضغط على Ctrl + Shift + Enter)
=IFERROR(INDEX($A$2:$A$12,SMALL(IF(LARGE(IF(MATCH($A$2:$A$12&"",$A$2:$A$12&"",0)=ROW($A$2:$A$12)-ROW($A$2)+1,SUMIF($A$2:$A$12,$A$2:$A$12,$B$2:$B$12),""),ROWS($D$2:D2))=SUMIF($A$2:$A$12,$A$2:$A$12,$B$2:$B$12),ROW($A$2:$A$12)-ROW($A$2)+1,""),SUM(--(LARGE((MATCH($A$2:$A$12&"",$A$2:$A$12&"",0)=ROW($A$2:$A$12)-ROW($A$2)+1)*SUMIF($A$2:$A$12,$A$2:$A$12,$B$2:$B$12),ROW($A$2:A2)-ROW($A$2)+1)=LARGE((MATCH($A$2:$A$12&"",$A$2:$A$12&"",0)=ROW($A$2:$A$12)-ROW($A$2)+1)*SUMIF($A$2:$A$12,$A$2:$A$12,$B$2:$B$12),ROWS($D$2:D2)))))),"")

المعادلة المستخدمة بالخلية E2
=SUMIF($A$2:$A$12,D2,$B$2:$B$12)

هنا تم ترتيب الارقام تصاعديا مباشرة ومن ثم وضع اجمالى كل منهم
استخدم ما شئت لكن المهم عندى هو ان تتعلم اكثر واكثر
لتحميل ملف العمل لرؤية الروابط والمرفقات عليك الرد على الموضوع
ولقد قمت بما لا يجعلك تضطر لتحميل الملف فلك ما شئت نقل البيانات والمعادلات
أو الدعم البسيط لصاحب الموضوع بتحميل الملف
مع تحياتى أخوكم فى الله اسلام عبدالله 81




لرؤية الروابط والمرفقات عليك الرد على الموضوع


أثارت هذه المشاركة إعجاب: ali mohamed ali، مهند محسن، 1982efgh1993، هانى على، YasserKhalil، الصقر،





29-08-2018 07:43 صباحا
مشاهدة مشاركة منفردة [1]
salim
menu_open
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 185
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
يتابعهم : 13
يتابعونه : 6
قوة السمعة : 2058
الاعجاب : 417
 offline 
look/images/icons/i1.gif ترتيب البيانات وفقا لاجمالى الارصدة
بارك الله فيك اخي اسلام
ملف مماثل لكن بواسطة Vba 
الكود في حدث تغيير قيمة اي خلية في العامودين A & B
الكود

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 2 And Target.Column <= 2 And Target.Count = 1 Then
 Application.EnableEvents = False
 ad_to_list
 End If
 Application.EnableEvents = True
End Sub
'=========================
Sub ad_to_list()
Application.EnableEvents = False
Dim My_rg As Range
Dim it As Range
Dim t$, x%
Dim lr%: lr = Cells(Rows.Count, 1).End(3).Row
Set My_rg = Range("a2:a" & lr)
Range("d1").CurrentRegion.Offset(1).ClearContents
With CreateObject("System.Collections.ArrayList")
For Each it In My_rg
 If Not .contains(it.Value) And it.Value <> "" Then .Add it.Value
Next
.Sort
.Reverse
Sheet1.Cells(2, 4).Resize(.Count, 1) = Application.Transpose(.toarray)
 For x = 2 To .Count + 1
    t = "=SUMPRODUCT(--($A$2:$A$" & lr & "=D" & x & "),$B$2:$B$" & lr & ")"
    Cells(x, 5) = Evaluate(t)
 Next
End With
Application.EnableEvents = True
End Sub


الملف مرفق

 




لرؤية الروابط والمرفقات عليك الرد على الموضوع


أثارت هذه المشاركة إعجاب: ali mohamed ali، مهند محسن، 1982efgh1993، هانى على، Eslam Abdullah، YasserKhalil،




29-08-2018 09:19 صباحا
مشاهدة مشاركة منفردة [2]
ali mohamed ali
menu_open
عضو محترف
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2017
رقم العضوية : 1757
المشاركات : 511
الدولة : مصر
الجنس : ذكر
يتابعهم : 0
يتابعونه : 22
قوة السمعة : 2613
الاعجاب : 805
 offline 
look/images/icons/i1.gif ترتيب البيانات وفقا لاجمالى الارصدة
بارك الله فيك استاذ اسلام وجعله فى ميزان حسناتك,موضوع مميز
أحسنت استاذ سليم كود ممتاز ورائع جزاكم الله جميعا كل خير

أثارت هذه المشاركة إعجاب: salim، 1982efgh1993، Eslam Abdullah،


توقيع :ali mohamed ali
{ وَقُل رَّبِّ زِدْنِي عِلْمًا }
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى حل أى مشكلة او أستفسار لديك مع إضافة رد بشكره
أو دعوة لمن قدم اليك المساعدة,فالجميع هنا يعمل على مساعدة
 الاخرين لوجه الله وان تحتسب له اجر عند الله


29-08-2018 09:28 صباحا
مشاهدة مشاركة منفردة [3]
مهند محسن
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-03-2018
رقم العضوية : 5025
المشاركات : 124
الجنس : ذكر
تاريخ الميلاد : 19-3-1990
يتابعهم : 0
يتابعونه : 4
قوة السمعة : 235
الاعجاب : 100
 offline 
look/images/icons/i1.gif ترتيب البيانات وفقا لاجمالى الارصدة
جزاكم الله كل خير وبارك الله فيكما استاذنا الكبير اسلام وخبيرنا العظيم الأستاذ سليم

أثارت هذه المشاركة إعجاب: 1982efgh1993، Eslam Abdullah،




29-08-2018 10:27 صباحا
مشاهدة مشاركة منفردة [4]
salim
menu_open
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 185
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
يتابعهم : 13
يتابعونه : 6
قوة السمعة : 2058
الاعجاب : 417
 offline 
look/images/icons/i1.gif ترتيب البيانات وفقا لاجمالى الارصدة
زيادة في اثراء الموضوع اكثر و أكثر هذا الكود

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Row > 2 And Target.Column <= 2 And Target.Count = 1 Then
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    ad_to_list_new
 End If
  Application.EnableEvents = True
  Application.ScreenUpdating = True
End Sub
'=========================
Sub ad_to_list_new()
Dim My_rg As Range
Dim t$, x%, y%
Dim lr%: lr = Cells(Rows.Count, 1).End(3).Row
Set My_rg = Range("a2:a" & lr)
Range("d1").CurrentRegion.Offset(1).ClearContents
'========================================
With Range("d2").Resize(lr - 1, 1)
 .Value = My_rg.Value
 .RemoveDuplicates Columns:=1
 .Sort key1:=Range("d2"), order1:=2
  y = Cells(Rows.Count, 4).End(3).Row
End With
 For x = 2 To y
    t = "=SUMPRODUCT(--($A$2:$A$" & lr & "=D" & x & "),$B$2:$B$" & lr & ")"
    Cells(x, 5) = Evaluate(t)
 Next
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 ' The last line (Before End Sub) for sorting by Minutes '
 ' If you want to do this delete the word "rem" befor it '
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Rem Range("d2").Resize(lr - 1, 2).Sort key1:=Range("e2"), order1:=1
 
End Sub





لرؤية الروابط والمرفقات عليك الرد على الموضوع


أثارت هذه المشاركة إعجاب: 1982efgh1993، هانى على، Eslam Abdullah، YasserKhalil،




29-08-2018 11:09 صباحا
مشاهدة مشاركة منفردة [5]
هانى على
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 10-03-2018
رقم العضوية : 4794
المشاركات : 202
الجنس : ذكر
تاريخ الميلاد : 1-4-1980
يتابعهم : 0
يتابعونه : 1
قوة السمعة : 313
الاعجاب : 134
 offline 
look/images/icons/i1.gif ترتيب البيانات وفقا لاجمالى الارصدة
بارك الله فيك استاذ اسلام وجزاك الله كل خير
والشكر ايضا لأستاذنا الكبير سليم كودان رائعان جزاك الله كل خير وبارك الله فيك

أثارت هذه المشاركة إعجاب: Eslam Abdullah،




29-08-2018 07:43 مساء
مشاهدة مشاركة منفردة [6]
Eslam Abdullah
menu_open
مشرف على لغات برمجة آخرى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1150
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
الدعوات : 2
يتابعهم : 3
يتابعونه : 55
قوة السمعة : 6888
الاعجاب : 1942
 offline 
look/images/icons/i1.gif ترتيب البيانات وفقا لاجمالى الارصدة
مشكور مرورك العطر أستاذ سليم ومشكور لاثرائك الموضوع نشاط جميل
ومشكور مروركم العطر أستاذ على وأستاذ مهند وأستاذ هانى على الموضوع
تقبلوا وافر احترامى وتقديرى 81

أثارت هذه المشاركة إعجاب: ali mohamed ali، salim،




29-08-2018 08:01 مساء
مشاهدة مشاركة منفردة [7]
Eslam Abdullah
menu_open
مشرف على لغات برمجة آخرى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1150
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
الدعوات : 2
يتابعهم : 3
يتابعونه : 55
قوة السمعة : 6888
الاعجاب : 1942
 offline 
look/images/icons/i1.gif ترتيب البيانات وفقا لاجمالى الارصدة
أخى العزيز سليم الظاهر كدا شربت من نفس الحاجه الاصفره اللى كنت شاربها laugh
الكود بيرتب ارقام الهاتف نفسها تصاعديا والهدف ترتيب الارقام وفقا لمجموع الزمن
يعنى اللى عدد دقائق بتاعته اكتر يكون فى الاول وهكذا
وخد بالك فى الجزء دا If Target.Row > 2 المفروض يكون =<
انا لو فاضى كنت عملت اسراء قصدى اثراء للموضوع بكود biggrin2 لكن نشوف كدا محاولات اخرى
تقبل وافر احترامى وتقديرى 81

أثارت هذه المشاركة إعجاب: salim،




29-08-2018 09:05 مساء
مشاهدة مشاركة منفردة [8]
salim
menu_open
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 185
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
يتابعهم : 13
يتابعونه : 6
قوة السمعة : 2058
الاعجاب : 417
 offline 
look/images/icons/i1.gif ترتيب البيانات وفقا لاجمالى الارصدة
المشاركة الأصلية كتبت بواسطة: Eslam Abdullah »
أخى العزيز سليم الظاهر كدا شربت من نفس الحاجه الاصفره اللى كنت شاربها laugh
الكود بيرتب ارقام الهاتف نفسها تصاعديا والهدف ترتيب الارقام وفقا لمجموع الزمن
يعنى اللى عدد دقائق بتاعته اكتر يكون فى الاول وهكذا
وخد بالك فى الجزء دا If Target.Row > 2 المفروض يكون =<
انا لو فاضى كنت عملت اسراء قصدى اثراء للموضوع بكود biggrin2 لكن نشوف كدا محاولات اخرى
تقبل وافر احترامى وتقديرى 81

استاذ اسلام​

 بشأن هذه الملاحظة : يعنى اللى عدد دقائق بتاعته اكتر يكون فى الاول وهكذا
هذه النقطة ملحوظة في الكود بهذا الجزء منه   (مكتوبة باللغة الاجنبية لصعوبة وضعها باللغة العربية في وسط محرر الــ VBA)

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 ' The last line (Before End Sub) for sorting by Minutes '
 ' If you want to do this delete the word "rem" befor it '
 'choose order1:=2 to descending order1:=1 to Ascending    '
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 Range("d2").Resize(lr - 1, 2).Sort key1:=Range("e2"), order1:=2
 
End Sub
 
فعلى المستخدم ان يزيل كلمة "Rem" من امام السطر الاخير من الكود قبل (End Sub)
 
 و يختار Order:=2  أو  Order:=1  حسب ما يريد الفرز تنازلي او تصاعدي  ( في العامود E)

أثارت هذه المشاركة إعجاب: Eslam Abdullah، YasserKhalil،




29-08-2018 09:48 مساء
مشاهدة مشاركة منفردة [9]
Eslam Abdullah
menu_open
مشرف على لغات برمجة آخرى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1150
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
الدعوات : 2
يتابعهم : 3
يتابعونه : 55
قوة السمعة : 6888
الاعجاب : 1942
 offline 
look/images/icons/i1.gif ترتيب البيانات وفقا لاجمالى الارصدة
انا عامتا مشوفتش الكود ، فعلته مباشرة على اساس انه المطلوب والكود الاول مش فيه الكلام دا !
وحتى اخر سطر فى التعليقات التى وضعتها الان لم اجدها داخل الكود

وعموما عمل جيد احسنت
والموضوع ابسط من كدا بالVBA كل هدفى هو اضافة افكار بالمعادلات فحسب
واتفضل كود اسهل لنفس الهدف

Sub AlsaqrOrder()
Dim lrw&, lr&, i&, rng As Range, RDup As New Collection
Range("D2:E" & Application.Max(Range("D" & Rows.Count).End(3).Row, 2)).ClearContents
lrw = Range("A" & Rows.Count).End(3).Row
    On Error Resume Next
    For Each rng In Range("A2:A" & lrw)
        If rng.Value <> "" Then RDup.Add rng.Value, CStr(rng.Value)
    Next rng
    For i = 1 To RDup.Count
        Cells(i + 1, 4) = RDup.Item(i)
        Cells(i + 1, 5) = Application.SumIf(Range("A2:A" & lrw), RDup.Item(i), Range("B2:B" & lrw))
    Next i
lr = Range("D" & Rows.Count).End(3).Row
'للترتيب التصاعدى استبدل رقم 2 برقم 1 فى السطر التالى
'لاستخراج البيانات الفريدة والاجمالى دون الترتيب ضع علامة ' قبل السطر التالى
    Range("D2:E" & lr).Sort key1:=Range("E2:E" & lr), Order1:=2
End Sub

أثارت هذه المشاركة إعجاب: YasserKhalil، salim،




30-08-2018 09:05 صباحا
مشاهدة مشاركة منفردة [10]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 4626
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 11
يتابعهم : 0
يتابعونه : 318
قوة السمعة : 13297
الاعجاب : 4914
 offline 
look/images/icons/i1.gif ترتيب البيانات وفقا لاجمالى الارصدة
الله ينور يا شباب ..تفاعل مثمر وحلول ممتازة 
بارك الله فيكم وجزاكم الله خيراً

أثارت هذه المشاركة إعجاب: الصقر، Eslam Abdullah،




30-08-2018 09:08 صباحا
مشاهدة مشاركة منفردة [11]
الصقر
menu_open عضوية موثقة
مراقب عام
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 2
المشاركات : 1408
الجنس : ذكر
الدعوات : 11
يتابعهم : 0
يتابعونه : 356
قوة السمعة : 11079
الاعجاب : 2753
 offline 
look/images/icons/i1.gif ترتيب البيانات وفقا لاجمالى الارصدة

رائع اخى الحبيب اسلام
142


أثارت هذه المشاركة إعجاب: YasserKhalil، Eslam Abdullah،




30-08-2018 04:53 مساء
مشاهدة مشاركة منفردة [12]
Eslam Abdullah
menu_open
مشرف على لغات برمجة آخرى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1150
الجنس : ذكر
تاريخ الميلاد : 1-9-1995
الدعوات : 2
يتابعهم : 3
يتابعونه : 55
قوة السمعة : 6888
الاعجاب : 1942
 offline 
look/images/icons/i1.gif ترتيب البيانات وفقا لاجمالى الارصدة
مشكور مرورك على الموضوع المتواضع
أستاذى الغالى ياسر 81
الاروع مرورك استاذى الحبيب حسام 81

أثارت هذه المشاركة إعجاب: YasserKhalil،






الكلمات الدلالية
لاجمالى ، الارصدة ، وفقا ، ترتيب ، البيانات ،


 







اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.



الساعة الآن 06:50 مساء

أعلن هنا
أعلن هنا
أعلن هنا