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

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

mahmoud nasr alhasany

بواسطه mahmoud nasr alhasany
في منتدى الاكسيل Excel

 مشاركة
إذهب إلى أفضل إجابة Solved by محمد هشام.,

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

mahmoud nasr alhasany

mahmoud nasr alhasany

قام بنشر
قام بنشر (معدل)

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

الرجاء مساعدتى

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

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim searchValue1 As String
    Dim searchValue2 As String
    Dim currentRow As Long

    searchValue1 = ComboBox1.Value
    searchValue2 = ComboBox3.Value

    Set ws = Worksheets("Sheet3")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    
'  ' تعريف رؤوس الأعمدة وعروضها
'    colHeaders = Split("كود", "صنف", "سعر", "كمية المخزون", "اسم المخزن", "تاريخ نهاية الصنف")
'    'colHeaders = Array("اسم المخزن", "كود", "صنف", "سعر", "كمية المخزون", "تاريخ نهاية الصنف")
    colWidths = "40;50;50;40;60;40"

    ' تهيئة ListBox2
    With ListBox2
        .Clear
        '.columnCount = UBound(colHeaders) + 1 ' عدد الأعمدة + 1 لرأس العمود
        .columnWidths = colWidths
        .columnCount = 6
        .Font.Size = 10
        .ColumnHeads = True
        ' تعيين رؤوس الأعمدة بشكل صريح (اختياري)
'        For i = 0 To UBound(colHeaders)
'       '     .List(.ListCount - 1, i) = colHeaders(i)
'       ListBox2.AddItem colHeaders(i)
'        Next i
    End With

    'ListBox2.Clear
    currentRow = 0

    For i = 2 To lastRow
        If ws.Cells(i, 5).Value = searchValue1 And _
           ws.Cells(i, 1).Value Like "*" & searchValue2 & "*" Then
            ListBox2.AddItem ws.Cells(i, 1).Value
            ListBox2.List(currentRow, 1) = ws.Cells(i, 2).Value
            ListBox2.List(currentRow, 2) = ws.Cells(i, 3).Value
            ListBox2.List(currentRow, 3) = ws.Cells(i, 4).Value
            ListBox2.List(currentRow, 4) = ws.Cells(i, 5).Value
             ListBox2.List(currentRow, 5) = ws.Cells(i, 6).Value
            currentRow = currentRow + 1
        End If
    Next i

    If ListBox2.ListCount = 0 Then
        MsgBox "لم يتم العثور على نتائج"
    End If
End Sub

 

 

عملية بحث بشرطين او اكثر.xlsm

تم تعديل بواسطه mahmoud nasr alhasany
رابط هذا التعليق
شارك
محمد هشام.

محمد هشام.

قام بنشر
قام بنشر

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

جرب هدا  

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim searchValue1 As String
    Dim searchValue2 As String
    Dim currentRow As Long
    Dim colHeaders As Variant

    searchValue1 = ComboBox1.Value
    searchValue2 = ComboBox3.Value

    Set ws = Worksheets("Sheet3")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' تعريف رؤوس الأعمدة
    colHeaders = Array("كود", "صنف", "سعر", "كمية المخزون", "اسم المخزن", "تاريخ نهاية الصنف")
    colWidths = "35;60;45;40;65;40"

    With ListBox2
        .Clear
        .ColumnCount = UBound(colHeaders) + 1
        .ColumnWidths = colWidths
        .Font.Size = 10
        .AddItem
        For i = 0 To UBound(colHeaders)
            .List(0, i) = colHeaders(i)
        Next i
    End With

    currentRow = 1

    For i = 2 To lastRow
        If ws.Cells(i, 5).Value = searchValue1 And _
           ws.Cells(i, 1).Value Like "*" & searchValue2 & "*" Then
            ListBox2.AddItem
            ListBox2.List(currentRow, 0) = ws.Cells(i, 1).Value
            ListBox2.List(currentRow, 1) = ws.Cells(i, 2).Value
            ListBox2.List(currentRow, 2) = ws.Cells(i, 3).Value
            ListBox2.List(currentRow, 3) = ws.Cells(i, 4).Value
            ListBox2.List(currentRow, 4) = ws.Cells(i, 5).Value
            ListBox2.List(currentRow, 5) = ws.Cells(i, 6).Value
            currentRow = currentRow + 1
        End If
    Next i

    If ListBox2.ListCount = 1 Then
        MsgBox "لم يتم العثور على نتائج"
    End If

    TextBox7.Text = "عدد السجلات في القائمة : (" & ListBox2.ListCount - 1 & ")"
    
    Call TOtal
End Sub

 

رابط هذا التعليق
شارك
mahmoud nasr alhasany

mahmoud nasr alhasany

قام بنشر
  • الكاتب
قام بنشر (معدل)

شكرا لك  محمد هشام.

الكود يعمل جيدا ولاكن اريد اظهار البيانات داخل رؤوس الاعمدة

ListBox2.ColumnHeads = True 

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim searchValue1 As String
    Dim searchValue2 As String
    Dim currentRow As Long
    Dim colHeaders As Variant

    searchValue1 = ComboBox1.Value
    searchValue2 = ComboBox3.Value

    Set ws = Worksheets("Sheet3")
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' تعريف رؤوس الأعمدة
    colHeaders = Array("كود", "صنف", "سعر", "كمية المخزون", "اسم المخزن", "تاريخ نهاية الصنف")
    colWidths = "35;60;45;40;65;40"

    With ListBox2
        .Clear
        .ColumnCount = UBound(colHeaders) + 1
        .ColumnWidths = colWidths
        .Font.Size = 10
        .ColumnHeads = True
        .AddItem
        For i = 0 To UBound(colHeaders)
            .List(0, i) = colHeaders(i)
        Next i
    End With
    currentRow = 1

    For i = 2 To lastRow
        If ws.Cells(i, 5).Value = searchValue1 And _
           ws.Cells(i, 1).Value Like "*" & searchValue2 & "*" Then
            ListBox2.AddItem
            ListBox2.List(currentRow, 0) = ws.Cells(i, 1).Value
            ListBox2.List(currentRow, 1) = ws.Cells(i, 2).Value
            ListBox2.List(currentRow, 2) = ws.Cells(i, 3).Value
            ListBox2.List(currentRow, 3) = ws.Cells(i, 4).Value
            ListBox2.List(currentRow, 4) = ws.Cells(i, 5).Value
            ListBox2.List(currentRow, 5) = ws.Cells(i, 6).Value
            currentRow = currentRow + 1
        End If
    Next i

    If ListBox2.ListCount = 1 Then
        MsgBox "لم يتم العثور على نتائج"
    End If

    TextBox7.Text = "عدد السجلات في القائمة : (" & ListBox2.ListCount - 1 & ")"
    
    Call TOtal
End Sub

 

تم تعديل بواسطه mahmoud nasr alhasany
رابط هذا التعليق
شارك
  • أفضل إجابة
محمد هشام.

محمد هشام.

قام بنشر
  • أفضل إجابة
قام بنشر

اخي @mahmoud nasr alhasany

 خاصية ColumnHeads = True في عنصر التحكم ListBox لا تعمل إلا إذا كانت البيانات مرتبطة مباشرة بنطاق خلايا من ورقة العمل باستخدام خاصية RowSource

عندما تستخدم الطريقة AddItem لإضافة البيانات يدويا لن يتم عرض رؤوس الأعمدة  حتى لو قمت بتعيين ColumnHeads = True

حاول إضافة رؤوس الأعمدة باستخدام عناصر Label بدلا من الاعتماد على رؤوس الأعمدة داخل الـ ListBox 

يمكنك تحديدها داخل كود تهيئة اليوزرفورم بعد اظافة عناصر label جديدة بعدد العناوين المرغوب عرضها وتسميتها بإسم مختلف لكي لا يتعارض الكود مع العناصر السابقة

مثلا (hrd1- hrd2-...-hrd6)

  

Private Sub UserForm_Initialize()
   'الكود الخاص بك
    Dim arr As Variant
    arr = Array("كود", "صنف", "سعر", "كمية المخزون", "اسم المخزن", "تاريخ نهاية الصنف")
    For i = 1 To 6
        Me("hrd" & i).Caption = arr(i - 1)
    Next i
End Sub

99999999999JPG.JPG.566b0e7ecb7fb60e5fb36cac2c6e9c90.JPG

وتعديل الكود على   Private Sub CommandButton1_Click() 

  With ListBox2
        .Clear
        .ColumnCount = 6
        .ColumnWidths = colWidths
        .Font.Size = 10
    End With
    currentRow = 0
    For i = 2 To lastRow
        If ws.Cells(i, 5).Value = searchValue1 And _
           ws.Cells(i, 1).Value Like "*" & searchValue2 & "*" Then
            ListBox2.AddItem
            ListBox2.List(currentRow, 0) = ws.Cells(i, 1).Value ' كود
            ListBox2.List(currentRow, 1) = ws.Cells(i, 2).Value ' صنف
            ListBox2.List(currentRow, 2) = ws.Cells(i, 3).Value ' سعر
            ListBox2.List(currentRow, 3) = ws.Cells(i, 4).Value ' كمية المخزون
            ListBox2.List(currentRow, 4) = ws.Cells(i, 5).Value ' اسم المخزن
            ListBox2.List(currentRow, 5) = ws.Cells(i, 6).Value ' تاريخ نهاية الصنف
            currentRow = currentRow + 1
        End If
    Next i

 

عملية بحث بشرطين او اكثر.xlsm

  • Like 1
  • Thanks 2
رابط هذا التعليق
شارك
mahmoud nasr alhasany

mahmoud nasr alhasany

قام بنشر
  • الكاتب
قام بنشر

الف شكر  / محمد هشام على التوضيح بعض النقاط توضيحا جيدا

وجزاك الله عنا خير الجزاء

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

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim searchValue1 As String
    Dim searchValue2 As String
    Dim currentRow As Long
    Dim DateMin As Date
    Dim DateMax As Date
    Dim includeDates As Boolean

    ' تحديد ورقة العمل
    Set ws = Worksheets("Sheet3")

    ' الحصول على القيم من عناصر التحكم
    searchValue1 = ComboBox1.Value
    searchValue2 = ComboBox3.Value
    If IsDate(TextBox1.Value) Then DateMin = CDate(TextBox1.Value)
    If IsDate(TextBox2.Value) Then DateMax = CDate(TextBox2.Value)
    includeDates = CheckBox1.Value ' تحديد قيمة مربع الاختيار

    ' تحديد الصف الأخير
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    ' مسح قائمة النتائج وتحديد عرض الأعمدة
    With ListBox2
        .Clear
        .ColumnCount = 6
        .ColumnWidths = "35;60;45;40;65;40"
        .Font.Size = 10
    End With

    ' البحث عن البيانات وتعبئة القائمة
    currentRow = 0
    For i = 2 To lastRow
        ' التحقق من الشروط
        If ws.Cells(i, 5).Value = searchValue1 And _
           ws.Cells(i, 1).Value Like "*" & searchValue2 & "*" And _
           (Not includeDates Or (ws.Cells(i, 6) >= DateMin And ws.Cells(i, 6) <= DateMax)) Then

            ' إضافة البيانات إلى القائمة
            ListBox2.AddItem
            ListBox2.List(currentRow, 0) = ws.Cells(i, 1).Value
            ListBox2.List(currentRow, 1) = ws.Cells(i, 2).Value
            ListBox2.List(currentRow, 2) = ws.Cells(i, 3).Value ' سعر
            ListBox2.List(currentRow, 3) = ws.Cells(i, 4).Value ' كمية المخزون
            ListBox2.List(currentRow, 4) = ws.Cells(i, 5).Value ' اسم المخزن
            'ListBox2.List(currentRow, 5) = ws.Cells(i, 6).Value ' تاريخ نهاية الصنف
            ListBox2.List(currentRow, 5) = Format(ws.Cells(i, 6).Value, "dd/mm/yyyy") ' تاريخ نهاية الصنف
            currentRow = currentRow + 1
        End If
    Next i

    If ListBox2.ListCount = 0 Then
        MsgBox "لم يتم العثور على نتائج"
    End If
    
        TextBox7.Text = "عدد السجلات في القائمة : (" & ListBox2.ListCount & ")"
        Call TOtal
    
End Sub

 

رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
 مشاركة
الذهاب الي قائمه المواضيع

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

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

Important Information

  I accept