مساعدة في الlistbox

[Ali994m]

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

أرجو المساعدة في شرح كود لتكون بيانات الlistbox 

بحيث تحتوي اخر عشر قيم من عمود ..... وجزاكم الله كل خير >>>>تــــم رفع الملف

listbox.xlsm

[حسين مامون]

ضع هذا الشيء في حدث الفورم

Private Sub UserForm_Initialize()
Dim lr1
Dim lr2
Dim i, k
ListBox1.ColumnCount = 3
lr1 = Cells(Rows.Count, 2).End(3).Row - 10
lr2 = Cells(Rows.Count, 2).End(3).Row
k = 0
For i = lr1 To lr2
ListBox1.AddItem
ListBox1.List(k, 0) = Cells(i, 1).Value
ListBox1.List(k, 1) = Cells(i, 2).Value
ListBox1.List(k, 2) = Cells(i, 3).Value

k = k + 1

Next i
End Sub

 

[حسين مامون]

وهذا الشيء لوكانت البيانات اقل من 10 

Private Sub UserForm_Initialize()
Dim lr1, lr
Dim lr2
Dim i, k
ListBox1.ColumnCount = 3
 lr = Cells(Rows.Count, 2).End(3).Row
If lr < 9 Then MsgBox "البيانات اقل من10": Exit Sub
lr1 = Cells(Rows.Count, 2).End(3).Row - 10
lr2 = Cells(Rows.Count, 2).End(3).Row
k = 0
For i = lr1 To lr2
ListBox1.AddItem
ListBox1.List(k, 0) = Cells(i, 1).Value
ListBox1.List(k, 1) = Cells(i, 2).Value
ListBox1.List(k, 2) = Cells(i, 3).Value

k = k + 1

Next i
End Sub

 

[سليم حاصبيا]

جرب هذه الملف

 ويمكن التعديل عليه ليتناسب مع ملفك

Option Explicit
Dim lr%
Const How_many = 10
Dim Sh As Worksheet
Dim i%, k%, x
'+++++++++++++++++++++++++++++++
Sub Begining()
Set Sh = Sheets("Sheet1")
lr = Sh.Cells(Rows.Count, 1).End(3).Row
End Sub
'++++++++++++++++++++++++++++++++++++
Private Sub CommandButton1_Click()
Begining
Dim t: t = 1
If lr < How_many + 1 Then Exit Sub
x = lr - How_many + 1
With Me.ListBox1
.Clear
.AddItem
.List(.ListCount - 1, 0) = "Count"
.List(.ListCount - 1, 1) = Sh.Cells(1, 1)
.List(.ListCount - 1, 2) = Sh.Cells(1, 2)
.List(.ListCount - 1, 3) = Sh.Cells(1, 3)
For k = x To lr
  .AddItem
  .List(.ListCount - 1, 0) = t
   t = t + 1
  For i = 1 To .ColumnCount - 1
    .List(.ListCount - 1, i) = _
    Sh.Cells(k, i)
  Next i
Next k
End With
End Sub
'+++++++++++++++++++++++++++++++
Private Sub UserForm_Initialize()
Begining

With Me.ListBox1
.AddItem
.List(.ListCount - 1, 0) = "Count"
.List(.ListCount - 1, 1) = Sh.Cells(1, 1)
.List(.ListCount - 1, 2) = Sh.Cells(1, 2)
.List(.ListCount - 1, 3) = Sh.Cells(1, 3)

For k = 2 To lr
  .AddItem
  .List(.ListCount - 1, 0) = k - 1
    For i = 1 To .ColumnCount - 1
    .List(.ListCount - 1, i) = _
    Sh.Cells(k, i)
  Next i
Next k
End With
Me.CommandButton1.Caption = _
"Laste " & How_many
End Sub

Laste_10.xlsm

[Ali994m]

جزاك الله كل خير 

كود رائع 

لكن حصلت معي مشاكل في جعل الأعمدة B, C هي فقط من تظهر 

أرجو المساعده في تعديل الكود 

وشكراً 

[سليم حاصبيا]

تم التعديل

Option Explicit
Dim lr%
Dim How_many
Dim Sh As Worksheet
Dim i%, k%, x
'+++++++++++++++++++++++++++++++
Sub Begining()
Set Sh = Sheets("Media")
lr = Sh.Cells(Rows.Count, 2).End(3).Row
If Val(Sh.Cells(1, "k")) < 1 _
 Or Sh.Cells(1, "k") > lr - 1 Then
    How_many = 10
Else
    How_many = Int(Sh.Cells(1, "k"))
    End If
Sh.Cells(1, "k") = How_many
End Sub
'+++++++++++++++++++++++++++++++
Private Sub cmd_reset_Click()
Me.ListBox1.Clear
UserForm_Initialize
End Sub

'++++++++++++++++++++++++++++++++++++
Private Sub Cmd_Show_Click()
Begining
Dim t: t = 1
If lr < How_many + 1 Then Exit Sub
x = lr - How_many + 1
With Me.ListBox1
.Clear
.AddItem
.List(.ListCount - 1, 0) = "Count"
.List(.ListCount - 1, 1) = Sh.Cells(1, 2)
.List(.ListCount - 1, 2) = Sh.Cells(1, 3)

For k = x To lr
  .AddItem
  .List(.ListCount - 1, 0) = t
   t = t + 1
  For i = 1 To .ColumnCount - 1
    .List(.ListCount - 1, i) = _
    Sh.Cells(k, i + 1)
  Next i
Next k
End With
Me.Cmd_Show.Caption = _
"Laste " & How_many
End Sub
'+++++++++++++++++++++++++++++++
Private Sub UserForm_Initialize()
Begining

With Me.ListBox1
.AddItem
.List(.ListCount - 1, 0) = "Count"
.List(.ListCount - 1, 1) = Sh.Cells(1, 2)
.List(.ListCount - 1, 2) = Sh.Cells(1, 3)
.List(.ListCount - 1, 4) = ""

For k = 2 To lr
  .AddItem
  .List(.ListCount - 1, 0) = k - 1
    For i = 1 To .ColumnCount - 2
    .List(.ListCount - 1, i) = _
    Sh.Cells(k, i + 1)
  Next i
  
Next k
End With
Me.Cmd_Show.Caption = _
"All Are Showing"

End Sub

الملف مرفق

Ali_listbox.xlsm