طلب ترحيل البيانات من تكس بوكس إلى ليست بوكس ثم إلى الشيت

[Akram-Al-Qifi]

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

لدي ملف أكسل وأريد ترحيل البيانات من التكست بوكس إلى الليست بوكس 

ثم إلى الشيت الملف مرفق مع التوضيح

شاكراً تعاونكم مقدماً

ترحيل البيانات من تكس بوكس إلى ليست بوكس ثم إلى الشيت.zip

[Akram-Al-Qifi]

اهلاً اخي عبد الفتاح وشكراً للرد

 

اخي انا اقوم بإدخال فاتورة أحياناً تتجاوز 20 صنف وفي بعض الاوقات لا ادري إلى أين وصلت في الفاتورة

فأضطر للخروج من الفورم و اقوم بعرض الشيتات وانا ليس لدي وقت لكل هذا

علماً بأن المشروع الذي لدي لا يسمح بترك الشيت للعرض وإنما اعمل باليوزر فورم فقط

وهذا الملف الذي اطلعت علية ليس إلا لعرض الفكرة أما البرنامج الذي اعمل علية فهو برنامج كبير

وإذا  وجد حل لمشكلتي سأكون لكم من الشاكرين

[عبدالفتاح في بي اكسيل]

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

جرب هذه الاكواد  ل10 اعمدة فقط  واذا كانت بياناتك  اكثر من 10 اعمدة  اعلمني   لعلي اجد طريقة لذلك 

Private Sub CommandButton1_Click()

    Dim iX As Integer
    With Me.ListBox1
        .AddItem
        For iX = 1 To 10
            .List(.ListCount - 1, iX - 1) = Me("textbox" & iX).Value
        Next iX
    End With
End Sub

Private Sub CommandButton2_Click()
    Dim lRw As Long
    With æÑÞÉ1
        lRw = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
        .Cells(lRw, 1).Resize(Me.ListBox1.ListCount, Me.ListBox1.ColumnCount).Value = Me.ListBox1.List
    End With
End Sub

 

[عبدالفتاح في بي اكسيل]

تفضل  هذا  الكود  ان شاء  الله سيعمل 

Private Sub CommandButton1_Click()
  
    Dim Ary As Variant
   Dim i As Long, j As Long
   
   If Me.ListBox1.ListCount > 0 Then
      Ary = Application.Transpose(Me.ListBox1.List)
      ReDim Preserve Ary(LBound(Ary) To UBound(Ary), LBound(Ary, 2) To UBound(Ary, 2) + 1)
      Ary = Application.Transpose(Ary)
   Else
      ReDim Ary(1 To 1, 1 To 20)
   End If
   j = UBound(Ary)
   For i = LBound(Ary, 2) To UBound(Ary, 2)
      Ary(j, i) = Me.Controls("Textbox" & i).Value
   Next i
   Me.ListBox1.List = Ary

End Sub

 

تم تعديل أبريل 13, 2020 بواسطه عبدالفتاح في بي اكسيل