عبدالله باقشير

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم شاهد المرفق 2010 Orginal.rar

السلام عليكم تم التعديل في الفورم 1 و2 فقط شاهد المرفق 2010 Pro.rar

الظاهر انك لم تحفظ الملف بعد استبدال الكود اعد المحاولة تحياتي

السلام عليكم استخدم المعادلة التالية في B2 واسحبها على باقي الجدول =IFERROR(VLOOKUP($A2;بيانات!$A$2:$D$1000;COLUMN();0);"") تحياتي

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم بالنسبة لهذا الطلب غير كود زر البحث في الفورم بهذا Private Sub ButtonFind_Click() Dim MyValue Dim MyAr() As String Dim ib As Boolean Dim R As Integer, i As Integer, ii As Integer Dim MyColmnFind As Integer, LastRow As Integer Dim dt1 As Date, dt2 As Date '------------------------- MyColmnFind = Me.ComboFind.ListIndex + 1 If MyColmnFind = 0 Then Exit Sub If MyColmnFind = 11 Then Me.TextFind = "" '------------------------- Me.ListFind.Clear '------------------------- With sRng.Worksheet LastRow = .Range("A65536").End(xlUp).Row If IsDate(Me.TextDate1) Then dt1 = DateValue(Me.TextDate1) Else dt1 = WorksheetFunction.Min(.Range("k2").Resize(LastRow)): Me.TextDate1 = Format(dt1, DateFormt) If IsDate(Me.TextDate2) Then dt2 = DateValue(Me.TextDate2) Else dt2 = WorksheetFunction.Max(.Range("k2").Resize(LastRow)): Me.TextDate2 = Format(dt2, DateFormt) End With '------------------------- sColmn = "" With sRng For R = 2 To LastRow Select Case .Cells(R, 11).Value2: Case dt1 To dt2 ib = CStr(.Cells(R, MyColmnFind)) = CStr(Me.TextFind) If ib Then sColmn = sColmn & R & " " ii = ii + 1 ReDim Preserve MyAr(1 To ContColmn, 1 To ii) For i = 1 To ContColmn If IsDate(.Cells(R, i)) Then MyValue = Format(.Cells(R, i).Value2, DateFormt) _ Else MyValue = .Cells(R, i).Value2 MyAr(i, ii) = MyValue Next End If End Select Next End With If ii Then Me.ListFind.Column = MyAr: Me.ListFind.ListIndex = 0 End Sub تحياتي

السلام عليكم ورحمة الله وبركاته جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم جرب هذا الكود Private Sub CommandButton1_Click() Dim Lr As Integer, i As Integer If Trim(Me.TextBox1) = "" Then Exit Sub Lr = Cells(Rows.Count, "B").End(xlUp).Row + 1 For i = 1 To 9 Cells(Lr, i + 1).Value = Me.Controls("TextBox" & i).Value Next End Sub تحياتي

السلام عليكم اهم تعديل في هذا المرفق هو استبدال الفورم المرن الاصدار الاخير (تجاوز اخطاء الفورم السابق) وتم تنفيذ بعض الطلبات الممكنه حاليا شاهد المرفق 2010 تعديل فورم البحث والتعديل.rar

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم ورحمة الله وبركاته جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم كود جميل اخي الحبيب الخالدي كنت اعمل على هذا الكود قبل ان ارى مشاركتكم Sub kh_Start() Dim R As Integer, RR As Integer, RRR As Integer, iCont As Integer Dim Lr As Long iCont = [F3] Lr = Cells(Rows.Count, "B").End(xlUp).Row - 1 Range("D2").Resize(Lr, 1).ClearContents With Range("H3") For R = 1 To iCont RRR = Abs(Int(-(Lr - RR) / (iCont - (R - 1)))) Range("D2").Cells(RR + 1, 1).Resize(RRR, 1).Value = .Cells(R, 1).Value RR = RR + RRR Next End With End Sub تحياتي

السلام عليكم ورحمة الله وبركاته جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم شاهد المرفق 2010 يتم رفعة على الموقع للافادة.rar

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم شاهد المرفق 2003 جمع+قسمه+ضرب.rar

السلام عليكم جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم جزاكم الله خيرا ملاحظة: تم تعديل المرفق في المشاركة 20 مع تعديل طفيف للمعادلة تقبلوا تحياتي وشكري

السلام عليكم الشكر واصل للجمع المبارك اسمحولي مشاركتكم هذا الحل المرفق 2003 Add.rar

السلام عليكم تم تعديل العنوان ارجوا الالتزام بقواعد المشاركة تحياتي

ولكم بمثله اضعاف مضاعفة .........جزاكم الله خيرا تقبلوا تحياتي وشكري

السلام عليكم ان شاء الله يكون المطلوب المرفق 2010 Clasccseur1.rar

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