اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

شكرا يا أخي الكريم على الأستجابة

حاولت كثيرا تطبيق الكود على برنامجي فلم ينجح

الكود يعمل بشكل جيد على ورقتك

عند نقل البيانات من ورقتي الى ورقتك كذلك توقف العمل فورا 

يعطي الرسالة التالية 

 

note.jpg

قام بنشر

ما شاء الله أخي الكريم 

شكرا لك 

تمت العملية بنجاح تام

أخي الكريم - العملية تأخذ بعض الوقت لأن النسخة الكاملة تحوي حتى الآن 14000 صف و هي قابلة للزيادة يوميا

هل يمكن التسريع قليلا

بعد أذنك و أرجو أن تحتملني :

طبقت الكود التالي لفرز البيانات باللست بوكس

الفرز حسب العمود الأول تمام - الفرز حسب العمود الثاني لم يعمل 

ممكن السبب

Private Sub ComboBox1_Change()
If ComboBox1.Value = "زبائن" Then
    Dim I As Long
    Dim j As Long
    Dim sTemp As String
    Dim sTemp2 As String
    
    Dim LbList As Variant

    LbList = Me.ListBox1.List
 For I = LBound(LbList, 1) To UBound(LbList, 1)
  For j = I + 1 To UBound(LbList, 1)
If LbList(I, 0) > LbList(j, 0) Then

 
                sTemp = LbList(I, 0)
                LbList(I, 0) = LbList(j, 0)
                LbList(j, 0) = sTemp
 
                sTemp2 = LbList(I, 1)
                LbList(I, 1) = LbList(j, 1)
                LbList(j, 1) = sTemp2
 
                 

            End If
        Next j
    Next I
 
    Me.ListBox1.Clear
 
    Me.ListBox1.List = LbList
End If
'-------------------------
If ComboBox1.Value = "مبيعات" Then
LbList = Me.ListBox1.List
 For I = LBound(LbList, 1) To UBound(LbList, 1)
  For j = I + 1 To UBound(LbList, 1)
If LbList(I, 1) > LbList(j, 1) Then
 
                sTemp = LbList(I, 0)
                LbList(I, 0) = LbList(j, 0)
                LbList(j, 0) = sTemp
 
                sTemp2 = LbList(I, 1)
                LbList(I, 1) = LbList(j, 1)
                LbList(j, 1) = sTemp2
 
                 
            End If
        Next j
    Next I
 
    Me.ListBox1.Clear
 
    Me.ListBox1.List = LbList
End If


End Sub

 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information