أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
مالك ماريه ali mohamed ali-- لا تميز خلال هذه الفترة YasserKhalil 2-طلب تحويل الكود من الحلقه التكراريه for الى array اكسيل اسئله واجابات


اعلان هنا
ألعاب فلاش أون لاين
أعلن هنا
أعلن هنا
صفحتنا على الفيس بوك
أعلن هنا



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





ترتيب التاريخ من الاصغر للأكبر وعرضها فى الليست بوكس

السلام عليكم ورحمة الله وبركاته . الموضوع ده كنت ناوى اسرده فى قسم لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدر ..



14-08-2019 05:53 مساء
عبدالرحمن صبحى
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 24-10-2018
رقم العضوية : 8466
المشاركات : 112
الجنس : ذكر
تاريخ الميلاد : 21-4-1996
الدعوات : 3
يتابعهم : 4
يتابعونه : 0
قوة السمعة : 138
الاعجاب : 42
 offline 

السلام عليكم ورحمة الله وبركاته .
الموضوع ده كنت ناوى اسرده فى قسم
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب ولكن وجدت بطئ شديد فى الكود وبدل من افاده الاعضاء اعطلهم biggrin2:

مرفق ملف فى شوية بيانات كده وفورم عليه كومند بوتن يقوم  بترتيب التاريخ ومن ثم يقوم بعرضه على الليست بوكس, والمطلوب تسريع الكود .

"انا قاصد احط بيانات كتيره علشان  انا عندى بيانات اكثر منها وكمان عشان اللى عنده كود اسرع او يعرف يسرع نفس الكود يبقى جزاه الله خيرا."
 
 
  sort date.zip   تحميل zip مرات التحميل :(4)
الحجم :(29.899) KB







15-08-2019 12:06 صباحا
مشاهدة مشاركة منفردة [1]
محمود ابو الدهب
menu_open
مشرف على لغات برمجة والاكسيل
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 14
المشاركات : 1268
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 4-7-1990
الدعوات : 59
يتابعهم : 6
يتابعونه : 215
قوة السمعة : 4193
الاعجاب : 519
موقعي : زيارة موقعي
 offline 
look/images/icons/i1.gif ترتيب التاريخ من الاصغر للأكبر وعرضها فى الليست بوكس
عبد الرحمن لما لا تستخدم الكود الى وضعته لك من قبل في موضوعك السابق الترحيل لاكثر من شيت اعمده متفرقة 

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

واليك الكود بعد التعديل استبدل القديم بهذا الكود


Private Sub CommandButton1_Click()
If ComboBox1.Value = "" Then: MsgBox "ادخل الصنف اولا": Exit Sub

    Dim myArray  As Variant
    Dim lr       As Long
    Dim X        As Long
    Dim rw       As Long
    Dim r        As Long
    Dim targt    As String
    Dim SERCH    As Worksheet
    Dim DATA     As Worksheet
    '____________________________________________
    Set DATA = Worksheets("ورقة1")    'اسم شيت قاعدة البيانات
    '____________________________________________
    lr = DATA.Cells(Rows.Count, 1).End(xlUp).Row    'اخر صف به بيانات
    ListBox1.Clear  'مسح نطاق البحث القديم
    targt = Me.ComboBox1.Text   'خلية البحث
    myArray = DATA.Range("A2:g" & lr)     'نطاق البحث
    '____________________________________________
    ReDim y(1 To UBound(myArray), 1 To 7)
    For X = LBound(myArray) To UBound(myArray)
        If myArray(X, 5) = targt Then
            rw = rw + 1
            For r = 1 To 7
                y(rw, r) = myArray(X, r)
            Next r
        End If
    Next X
    If rw > 0 Then
        ListBox1.AddItem
        ListBox1.List = y()
    End If
' تحياتى وتقدريى / محمود ابوالدهب
End Sub



تحياتى وتقديرى
 

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


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

تحياتى وتقدير للجميع  محمود ابوالدهب


15-08-2019 08:28 صباحا
مشاهدة مشاركة منفردة [2]
عبدالرحمن صبحى
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 24-10-2018
رقم العضوية : 8466
المشاركات : 112
الجنس : ذكر
تاريخ الميلاد : 21-4-1996
الدعوات : 3
يتابعهم : 4
يتابعونه : 0
قوة السمعة : 138
الاعجاب : 42
 offline 
look/images/icons/i1.gif ترتيب التاريخ من الاصغر للأكبر وعرضها فى الليست بوكس
جزاك الله خيرا استاذ محمود .
بالفعل انا حاولت ولكن لم ينجح معى واعطانى اخطاء كل اما اصحح خطأ يظهر خطأ جديد،وزى ما بيقولوا ادى العيش لخبازه وأنا الصراحه فى المصفوفات ضعيف شويتين تلاته كده ،فقولت احط الكود الخاص بى واخلى الطلب واحد ومفيد 
وعلى العموم جزاك الله خيرا 





15-08-2019 09:23 صباحا
مشاهدة مشاركة منفردة [3]
عبدالرحمن صبحى
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 24-10-2018
رقم العضوية : 8466
المشاركات : 112
الجنس : ذكر
تاريخ الميلاد : 21-4-1996
الدعوات : 3
يتابعهم : 4
يتابعونه : 0
قوة السمعة : 138
الاعجاب : 42
 offline 
look/images/icons/winner_first_h4h.gif ترتيب التاريخ من الاصغر للأكبر وعرضها فى الليست بوكس
استاذ محمود جزاك الله خيرا على اهتمامك

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


 


Private Sub CommandButton3_Click()
If ComboBox1.Value = "" Then: MsgBox "ادخل الصنف اولا": Exit Sub

    Dim myArray  As Variant
    Dim lr       As Long
    Dim X        As Long
    Dim rw       As Long
    Dim r        As Long
    Dim targt    As String
    Dim SERCH    As Worksheet
    Dim DATA     As Worksheet
    '____________________________________________
    Set DATA = Worksheets("data")
    '____________________________________________
    lr = DATA.Cells(Rows.Count, 3).End(xlUp).Row
    ListBox1.Clear
    targt = Me.ComboBox1.Text
    myArray = DATA.Range("a3:o" & lr)
    '____________________________________________
    c = "01/09/2018"

    ReDim y(1 To UBound(myArray), 1 To 9)
    For X = LBound(myArray) To UBound(myArray)
        If myArray(X, 3) = c + X And myArray(X, 12) = targt Then
            rw = rw + 1
             y(rw, 1) = rw
            y(rw, 3) = myArray(X, 9)
            y(rw, 2) = Format(myArray(X, 3), "yyyy/mm/dd")
            y(rw, 4) = myArray(X, 10)
            y(rw, 5) = myArray(X, 5)
            y(rw, 6) = myArray(X, 12)
            y(rw, 7) = myArray(X, 13)
            y(rw, 8) = myArray(X, 14)
            y(rw, 9) = myArray(X, 13) * myArray(X, 14)
        End If
    Next X
    If rw > 0 Then
        ListBox1.AddItem
        ListBox1.list = y()
    End If

End Sub



الخطأ هنا
 
If myArray(X, 3) = c + X And myArray(X, 12) = targt Then ​





15-08-2019 09:39 صباحا
مشاهدة مشاركة منفردة [4]
عبدالرحمن صبحى
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 24-10-2018
رقم العضوية : 8466
المشاركات : 112
الجنس : ذكر
تاريخ الميلاد : 21-4-1996
الدعوات : 3
يتابعهم : 4
يتابعونه : 0
قوة السمعة : 138
الاعجاب : 42
 offline 
look/images/icons/i1.gif ترتيب التاريخ من الاصغر للأكبر وعرضها فى الليست بوكس
وبعد عدة محاولات توصلت لحل فى نفس الكود ولكن التنفيذ بطئ ولكن ليس بنفس البطئ الموجود فى الكود الاول وهذا هو الكود




Private Sub CommandButton3_Click()
If ComboBox1.Value = "" Then: MsgBox "ادخل الصنف اولا": Exit Sub

    Dim myArray  As Variant
    Dim lr       As Long
    Dim X        As Long
    Dim rw       As Long
    Dim r        As Long
    Dim targt    As String
    Dim SERCH    As Worksheet
    Dim DATA     As Worksheet
   ' Dim v        As Integer
    Dim c        As Date
    '____________________________________________
    Set DATA = Worksheets("data")
    '____________________________________________
    lr = DATA.Cells(Rows.Count, 3).End(xlUp).Row
    ListBox1.Clear
    targt = Me.ComboBox1.Text
    myArray = DATA.Range("a3:o" & lr)
    '____________________________________________
    c = "01/09/2018"

    ReDim y(1 To UBound(myArray), 1 To 9)
   For v = 0 To lr
    For X = LBound(myArray) To UBound(myArray)
        If myArray(X, 3) = c + v Then
        If myArray(X, 12) = targt Then
            rw = rw + 1
             y(rw, 1) = rw
            y(rw, 3) = myArray(X, 9)
            y(rw, 2) = Format(myArray(X, 3), "yyyy/mm/dd")
            y(rw, 4) = myArray(X, 10)
            y(rw, 5) = myArray(X, 5)
            y(rw, 6) = myArray(X, 12)
            y(rw, 7) = myArray(X, 13)
            y(rw, 8) = myArray(X, 14)
            y(rw, 9) = myArray(X, 13) * myArray(X, 14)
        End If
        End If
    Next X
    Next v
    If rw > 0 Then
        ListBox1.AddItem
        ListBox1.list = y()
    End If

End Sub

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




15-08-2019 10:09 صباحا
مشاهدة مشاركة منفردة [5]
ali mohamed ali
menu_open
مشرف على منتدى الاكسيل
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2017
رقم العضوية : 1757
المشاركات : 1311
الدولة : مصر
الجنس : ذكر
الدعوات : 1
يتابعهم : 0
يتابعونه : 53
قوة السمعة : 6071
الاعجاب : 843
 offline 
look/images/icons/i1.gif ترتيب التاريخ من الاصغر للأكبر وعرضها فى الليست بوكس
بارك الله فيك 
والشكر موصول طبعا لأستاذنا الكبير محمود ابو الدهب

أثارت هذه المشاركة إعجاب: عبدالرحمن صبحى، محمود ابو الدهب،


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


15-08-2019 08:25 مساء
مشاهدة مشاركة منفردة [6]
محمود ابو الدهب
menu_open
مشرف على لغات برمجة والاكسيل
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 14
المشاركات : 1268
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 4-7-1990
الدعوات : 59
يتابعهم : 6
يتابعونه : 215
قوة السمعة : 4193
الاعجاب : 519
موقعي : زيارة موقعي
 offline 
look/images/icons/i1.gif ترتيب التاريخ من الاصغر للأكبر وعرضها فى الليست بوكس
طيب بص يا ريس 
ايه رايك في التعديل التالى

Private Sub CommandButton1_Click()
If ComboBox1.Value = "" Then: MsgBox "ادخل الصنف اولا": Exit Sub

    Dim myArray  As Variant
    Dim lr       As Long
    Dim X        As Long
    Dim rw       As Long
    Dim r        As Long
    Dim targt    As String
    Dim SERCH    As Worksheet
    Dim DATA     As Worksheet
    '____________________________________________
    Set DATA = Worksheets("ورقة1")    'اسم شيت قاعدة البيانات
    '____________________________________________
    lr = DATA.Cells(Rows.Count, 1).End(xlUp).Row    'اخر صف به بيانات
    ListBox1.Clear  'مسح نطاق البحث القديم
    targt = Me.ComboBox1.Text   'خلية البحث
    DATA.Range("a1:g" & lr).Sort Key1:=DATA.Range("a1:a" & lr), Order1:=xlAscending, Header:=xlYes
    myArray = DATA.Range("A2:g" & lr)     'نطاق البحث
    '____________________________________________
    ReDim y(1 To UBound(myArray), 1 To 7)
    For X = LBound(myArray) To UBound(myArray)
        If myArray(X, 5) = targt Then
            rw = rw + 1
                y(rw, 1) = Format(myArray(X, 1), "yyyy/mm/dd")
            For r = 2 To 7
                y(rw, r) = myArray(X, r)
            Next r
        End If
    Next X
    If rw > 0 Then
        ListBox1.AddItem
        ListBox1.List = y()
    End If
' تحياتى وتقدريى / محمود ابوالدهب
End Sub


وفيه وضعت سطر واحد قبل تخزين البيانات في المصفوفه

DATA.Range("a1:g" & lr).Sort Key1:=DATA.Range("a1:a" & lr), Order1:=xlAscending, Header:=xlYes


مهمه هذا السطر هو ترتيب البيانات في شيت العمل ترتيب تازلى على حسب التاريخ 
وبكد يبقي استغنينا عن الحلقة التكرارية الاخر الى حضرتك وضعتها والى ممكن تتقل الكود تلت مرات عن سرعة الحقيقة 
جرب وقلى رأيك
كما انى عدلتلك تنسيق التاريخ ليظهر yyyy/mm/dd
تحياتى وتقديرى
 

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


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

تحياتى وتقدير للجميع  محمود ابوالدهب


16-08-2019 01:30 مساء
مشاهدة مشاركة منفردة [7]
عبدالرحمن صبحى
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 24-10-2018
رقم العضوية : 8466
المشاركات : 112
الجنس : ذكر
تاريخ الميلاد : 21-4-1996
الدعوات : 3
يتابعهم : 4
يتابعونه : 0
قوة السمعة : 138
الاعجاب : 42
 offline 
look/images/icons/i1.gif ترتيب التاريخ من الاصغر للأكبر وعرضها فى الليست بوكس
جزاك الله خيرا استاذ  محمود ابو الدهب
تمام ظبط معايا وسريع الف شكر ليك 

تحياتى وتقديرى

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




17-08-2019 05:34 صباحا
مشاهدة مشاركة منفردة [8]
محمود ابو الدهب
menu_open
مشرف على لغات برمجة والاكسيل
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 14
المشاركات : 1268
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 4-7-1990
الدعوات : 59
يتابعهم : 6
يتابعونه : 215
قوة السمعة : 4193
الاعجاب : 519
موقعي : زيارة موقعي
 offline 
look/images/icons/i1.gif ترتيب التاريخ من الاصغر للأكبر وعرضها فى الليست بوكس
تمام والحمد لله على تمام طلبك
 

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


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

تحياتى وتقدير للجميع  محمود ابوالدهب


17-08-2019 07:01 صباحا
مشاهدة مشاركة منفردة [9]
الصقر
menu_open عضوية موثقة
مدير المنتدى
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 2
المشاركات : 1726
الجنس : ذكر
الدعوات : 17
يتابعهم : 0
يتابعونه : 578
قوة السمعة : 17820
الاعجاب : 370
موقعي : زيارة موقعي
 offline 
look/images/icons/i1.gif ترتيب التاريخ من الاصغر للأكبر وعرضها فى الليست بوكس

الله ينور يا ابوالحداحيد 142



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


توقيع :الصقر

اخى العضو الكريم
اذا كنت ترى ان المنتدى مفيد لك
فكن سفيرا لنا بدعوة الاخرين للانضمام معنا
فالدال على الخير كفاعله



17-08-2019 07:49 صباحا
مشاهدة مشاركة منفردة [10]
محمود ابو الدهب
menu_open
مشرف على لغات برمجة والاكسيل
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 14
المشاركات : 1268
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 4-7-1990
الدعوات : 59
يتابعهم : 6
يتابعونه : 215
قوة السمعة : 4193
الاعجاب : 519
موقعي : زيارة موقعي
 offline 
look/images/icons/i1.gif ترتيب التاريخ من الاصغر للأكبر وعرضها فى الليست بوكس
هذا نقطة في بحر علمكم استاذى العزيز 
 



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

تحياتى وتقدير للجميع  محمود ابوالدهب


30-09-2019 12:36 مساء
مشاهدة مشاركة منفردة [11]
عبدالرحمن صبحى
menu_open
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 24-10-2018
رقم العضوية : 8466
المشاركات : 112
الجنس : ذكر
تاريخ الميلاد : 21-4-1996
الدعوات : 3
يتابعهم : 4
يتابعونه : 0
قوة السمعة : 138
الاعجاب : 42
 offline 
look/images/icons/i1.gif ترتيب التاريخ من الاصغر للأكبر وعرضها فى الليست بوكس
كان عندى سؤال  ليس فى هذا الموضوع ولا يحتاج الى فتح موضوع جديد :
وانما هو فى كود المصفوفه نفسة اذا تم استخدام الترحيل الى الليست بوكس كما هو موضح فى الكود
    If rw > 0 Then
        ListBox1.AddItem
        ListBox1.List = y()
    End If


يظهر فى الليست بوكس صفوف فارغة بعدد الصفوف الموجوده بصفحة العمل فهل من حل 

 





30-09-2019 01:05 مساء
مشاهدة مشاركة منفردة [12]
YasserKhalil
menu_open عضوية موثقة
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 7794
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 19
يتابعهم : 0
يتابعونه : 418
قوة السمعة : 22535
الاعجاب : 2010
 offline 
look/images/icons/i1.gif ترتيب التاريخ من الاصغر للأكبر وعرضها فى الليست بوكس
يمكن الاعتماد على متغير تستخدمه كعداد لتحديد عدد الصفوف
ولو فشلت في تنفيذ الفكرة يفضل طرح موضوع جديد مع ملف مرفق لتتضح صورة المشكلة بشكل أكبر






المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
دالة للتعامل مع أجزاء الوقت والتاريخ DatePart Function In VBA YasserKhalil
16 269 YasserKhalil
دالة لتحويل التاريخ الميلادي إلى تاريخ هجري Gregorian Hijri Converter UDF YasserKhalil
7 92 YasserKhalil
عدم تعديل التاريخ بعد الادخال khaled alborene
5 75 YasserKhalil
دالة لتحويل التاريخ الهجري إلى تاريخ ميلادي Hijri Gregorian Converter UDF YasserKhalil
4 81 YasserKhalil
إدراج التاريخ والوقت الحالي باستخدام المعادلات والأكواد Insert Date And Time Stamp YasserKhalil
2 65 YasserKhalil

الكلمات الدلالية
بوكس ، الليست ، وعرضها ، للأكبر ، الاصغر ، التاريخ ، ترتيب ،


 







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



الساعة الآن 05:20 صباحا

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