AMIRBM قام بنشر أغسطس 5 قام بنشر أغسطس 5 السلام عليكم ورحمة الله وبركاته اخواني الكرام أسعد الله أوقاتكم أطلب منكم المساعدة في تنسيق الشهر في فورم الإكسل حيث الشهر يظهر لي أرقام في القائمة المنسدلة ( في الفورم ) " الملف مرفق وشكرا. تنسيق الشهر.xlsb
محمد هشام. قام بنشر أغسطس 6 قام بنشر أغسطس 6 وعليكم السلام ورحمة الله تعالى وبركاته بعد معاينة الملف اظن انك في حاجة الى اعادة النظر في طريقة جلب البيانات الى الليست بوكس اما بخصوص تنسيق الشهر يمكنك تجربة شيء كهدا سيوفي بالغرض Private Sub UserForm_Initialize() Dim cel As Range Set f = Sheets("2") ' For Each cel In f.Range("S4:S" & f.[S65000].End(xlUp).Row) 'OR For Each cel In Range("moi") If cel.Value <> "" Then ComboBox1.AddItem Format(cel, "mmmm") End If Next cel End Sub 1
محمد هشام. قام بنشر أغسطس 6 قام بنشر أغسطس 6 (معدل) قم بحذف الارتباط الذي وضعته من قبل من الكومبوبوكس (rowsource moi) للحصول على أسماء الشهور كما سبق الذكر طريقة فلترة البيانات خاطئة حاول شرح ما تحاول فعله ربما نستطيع مساعدتك تم تعديل أغسطس 6 بواسطه محمد هشام. 1
أفضل إجابة محمد هشام. قام بنشر أغسطس 7 أفضل إجابة قام بنشر أغسطس 7 (معدل) العفو اخي @AMIRBM يسعدنا اننا استطعنا مساعدتك اليك هدا الاقتراح بطريقتي مع تحديث اسماء الشهور بدون الحاجة لوضعها في عمود مستقل Option Explicit Dim myFormat(1) As String Dim Arr As Variant Private Sub UserForm_Initialize() Dim OneRng(), i As Integer, n As Integer Dim f As Worksheet: Set f = Sheets("1") '<====' نطاق البيانات OneRng = f.Range("A3:F" & f.Range("B" & f.Rows.Count).End(xlUp).Row).Value ListBox1.List = OneRng cbxShtName.Value = f.Name With ListBox1 .ColumnCount = 6 .ColumnWidths = "60;170;140;90;90;90" .BorderStyle = fmBorderStyleSingle End With '<====' رؤوس الاعمدة For i = 1 To 6: Me("label" & i) = f.Cells(2, i): Next i End Sub '========================= Private Sub colRecherche(Tbl As Long, Cpt As Long) Dim cnt As Long, dict As Long cnt = UBound(Arr, 2) With ListBox1 .AddItem For dict = 1 To cnt .List(Tbl, dict - 1) = Arr(Cpt, dict) Next dict .List(Tbl, 1) = Format$(.List(Tbl, 1), _ "dddd, mmmm dd, yyyy") '<====' التاريخ .List(Tbl, 4) = Format$(.List(Tbl, 4), "0.00") '<====' مبلغ الوحدة .List(Tbl, 5) = Format$(.List(Tbl, 5), "0.00") '<====' المجموع End With End Sub '========================= Private Sub Filtre() Dim Cpt As Long, dict As Long, tmp As Long, cnt As Long, n As Long Dim Clé As Boolean, Réf As Boolean, sFilter As String Clé = Len(ComboBox1.Value) Réf = Len(tbxSearch) tmp = UBound(Arr, 1): cnt = UBound(Arr, 2) With Me.ListBox1 If .ListCount > 0 Then .RowSource = "" .Clear End If 'فلترة باسم الشهر If Clé Then sFilter = ComboBox1.Value For Cpt = 3 To tmp If Clé Then If Format(CDate(Arr(Cpt, 2)), "mmmm") Like sFilter Then colRecherche n, Cpt n = n + 1 End If Else colRecherche n, Cpt n = n + 1 End If Next Cpt If Réf Then 'فلترة باسم البضاعة sFilter = tbxSearch For n = .ListCount - 1 To 0 Step -1 If Not UCase(.List(n, 2) Like UCase("*" & sFilter & "*")) Then .RemoveItem (n) End If Next n End If End With Count.Caption = ListBox1.ListCount: SumColumns End Sub '========================= Private Sub cbxShtName_Change() Dim xMonth As Object 'اسماء الشهور المتوفرة Dim Cpt As Long, tmp As Long Dim WS As Worksheet: Set WS = Sheets("1") With WS.Range("A1:F" & WS.[B650000].End(xlUp).Row) Arr = .Value tmp = UBound(Arr, 1) Filtre Set xMonth = CreateObject("Scripting.Dictionary") xMonth("*") = "" For Cpt = 3 To tmp ' '<====' تنسيق اسم الشهر xMonth(Format(CDate(Arr(Cpt, 2)), "mmmm")) = Empty Next Cpt Me.ComboBox1.List = xMonth.keys End With End Sub '========================= Private Sub CommandButton1_Click() Dim WS As Worksheet: Set WS = Sheets("2") If ListBox1.ListCount = 0 Then: Exit Sub If MsgBox("ترحيل البيانات" & " ؟", vbYesNo) = vbNo Then Exit Sub WS.Range("B5:G" & WS.Rows.Count).ClearContents WS.[b5].Resize(Me.ListBox1.ListCount, 6) = Me.ListBox1.List End Sub تنسيق الشهر V2.xlsb تم تعديل أغسطس 7 بواسطه محمد هشام. 2
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.