بردو اتكرر موضوعك استاذ ؟؟؟ يرجى تغير اسمك لكةى نتواصل جيدا
ومع التكرارا لم ييتغير شبي بالمعطيات فهى نفسها
قارن بين موضوعك الاول
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
والموضوع التالى لن تجد سوى مجموعه بيانات مدخلة طيب انته طالب ايه ؟ لا شي
ولكن على قدر فهمى لطلباتك
فطلبك الاول كود بحث يظهر النتيجه باليست
ضع الكود التالى في زر المبيعات
ومهمته يبحث عن كود الصنف وياخذ الكمية التى تكتبها ثم يضعهم باليست
واذا ضغط علية مرة اخر يضع لابيانات الجديده تحت التى تسبقها باليست
Private Sub CommandButton21_Click()
Dim myArray As Variant
Dim lr As Long
Dim rw As Long
Dim X As Long
Dim r As Long
Dim DATA As Worksheet
If Me.TextBox1.Value = "" Or Me.TextBox2.Value = "" Then
MsgBox "برجاء التأكد من ادخال كود الصنف والكمية المراد بيعها"
Exit Sub
End If
'____________________________________________
Set DATA = Worksheets("ورقة1") 'اسم شيت قاعدة البيانات
'____________________________________________
lr = DATA.Cells(Rows.Count, 1).End(xlUp).Row 'اخر صف به بيانات
myArray = DATA.Range("a2:e" & lr) 'نطاق البحث
ReDim y(1 To lr, 1 To 5) ' انشاء مصفوفة جديده لحفظ البيانات بها
'____________________________________________
For X = 1 To lr - 1
' حلقة للجمع
If myArray(X, 1) = Me.TextBox1.Text Then
' للتاكد ان ما بالمبياعات موجود فعليا بالمخزن
If myArray(X, 3) < Val(Me.TextBox2.Text) Then
MsgBox "الكمية المراد بيعاها اقل مما هى موجوده بالمخزن"
Exit Sub
End If
' اذا كانت الكمية المراد بيعاها اقل مما في المخزن يستدعى البيانات لليست
rw = rw + 1
y(rw, 1) = myArray(X, 1)
y(rw, 2) = myArray(X, 2)
' هنا نضع الكمية في اليست الكمية المراد بيعاها وليست التى بالمخزن
y(rw, 3) = Me.TextBox2.Text
y(rw, 4) = myArray(X, 4)
y(rw, 5) = myArray(X, 5)
Exit For
End If
Next X
' اذا كان المتغير rw
' اكبر من الصفر معناه انه وجد بيانات متطابقة وعلية ينفذ التالى
If rw > 0 Then
r = Me.ListBox1.ListCount
Me.ListBox1.AddItem
Me.ListBox1.List(r, 0) = y(rw, 1)
Me.ListBox1.List(r, 1) = y(rw, 2)
Me.ListBox1.List(r, 2) = y(rw, 3)
Me.ListBox1.List(r, 3) = y(rw, 4)
Me.ListBox1.List(r, 4) = y(rw, 5)
End If
' تحياتى وتقديرى محمود على محمد ابو دهب
End Sub
ولو لاحظت بعت كود زى ده ليك من قبل في احد الموضوعات الى طلبت بها , كان ينقصك بعض التعديل البسيط عليه
اما بخصوص الترحيل
فضع الكود التالى في زر مردوات ومسموحات المبيعات
Private Sub CommandButton22_Click()
Dim i As Long
Dim lr As Long
Dim DATA As Worksheet
Set DATA = Worksheets("ورقة2") 'اسم شيت قاعدة البيانات
'____________________________________________
lr = DATA.Cells(Rows.Count, 1).End(xlUp).Row + 1 'اخر صف به بيانات
With Me.ListBox1
For i = 0 To .ListCount - 1
DATA.Range("a" & lr).Value = .List(i, 0)
DATA.Range("b" & lr).Value = .List(i, 1)
DATA.Range("c" & lr).Value = .List(i, 2)
DATA.Range("d" & lr).Value = .List(i, 3)
DATA.Range("e" & lr).Value = .List(i, 4)
lr = lr + 1
Next i
End With
Me.ListBox1.Clear
End Sub
وبالنهاية اتمنى يكون ده طلبك
[1]
بحث في الليست بوكس
تحميل محتوى الموضوع
عرض نسخة صالحة للطباعة
أرسل هذا الموضوع إلى صديق
