حسونة حسين

وعليكم السلام ورحمه الله وبركاته تفضل اخي Prodaction2.xlsm

جرب هذا اخي متابعة7.xlsm

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

وعليكم السلام ورحمة الله وبركاته اجعل المعادله كالتالي =IF(C5="";"";+DAYS360(C5;E5))

المشكله عندك في تنسيق الاعمده الخاصه بالتواريخ موجوده mm/dd/yyyy اجعلها التنسيق الذي تريد عن طريق Format cells dd/mm/yyyy

اخي @محمود الطحاوي وارد هيئه ١ أبريل ولا ٤ يناير بدايه النشاط تاريخ ٥ أبريل ولا ٤ مايو وارد متابعه ٦ مايو ولا ٥ يونيو

اخي @محمود الطحاوي ارفق صورة للفورم بعد أن تقوم بكتابه جميع بيانات الفورم

وعليكم السلام ورحمة الله وبركاته جرب هذا التعديل المصنف1.xlsm

الحمد لله الذي بنعمته تتم الصالحات

وعليكم السلام ورحمه الله وبركاته For Each w In ThisWorkbook.Worksheets If w.Name <> "ورقة7" And w.Name <> "ورقة8" Then co1.AddItem w.Name End If Next w

وعليكم السلام ورحمة الله وبركاته عليك بفك دمج الخلايا قم بارفاق ملف مبسط لكي يتم العمل عليه مع تغيير البيانات الخاصه باي بيانات غير حقيقيه

تفضل ملف متابعة.xlsm

السلام عليكم ورحمه الله وبركاته وبها نبدأ تفضل ضع هذا الكود في حدث الشيت المطلوب Private Sub Worksheet_Change(ByVal Target As Range) Dim X As Range Application.EnableEvents = False For Each X In Target If X.Row > 3 Then If X.Column = 2 Then If X.Value = "ok" Then X.Offset(0, -1).Value = Date ElseIf X.Column = 3 Then If X.Offset(0, -1).Value = "ok" Then X.Offset(0, 1).Value = X End If End If Next X Application.EnableEvents = True End Sub

الشكر لله اخى

السلام عليكم ورحمه الله وبركاته تفضل أفريل.xlsx

وعليكم السلام ورحمه الله وبركاته تفضل 2017-Final.xlsb

وعليكم السلام ورحمة الله وبركاته اخي @الأستاذ سيد الأكرت الملفات المرفقه ليست ملفات اكسيل او انها تم تشفيرها والله اعلم اخي @aaaaaauto @محمد الشابورى الملف الذي ارفقته باسم test.xlsx في هذه المشاركه ليس به مشكله وهو ملف سليم فقط قم بتغيير امتداد الملف الي xlsm

نعم اخي ان شاء الله

وعليكم السلام ورحمة الله وبركاته عدل xls إلى xlsx في هذا السطر

وجزاكم مثله اخى الحمد لله الذي بنعمته تتم الصالحات

الشكر لله اخى

الكود مصنوع لكي تكون الثانيه اسمها List2 كما في هذا السطر ان اردت تغييرها لابد من تغييرها في هذا السطر X = Application.Match("List2", Sheet2.Range("A2:A" & LR), 0) + 1 الاولي اكتب اسمها كما تريد ليس لها أي علاقه في الكود

الحمد لله الذي بنعمته تتم الصالحات

تفضل اخي Option Explicit Sub Test() Dim WSData As Worksheet, WSResult As Worksheet, Arr, Ar1, Ar2 Dim I As Long, J As Long, P As Long Application.ScreenUpdating = False Application.EnableEvents = False Set WSData = Worksheets("Sheet1") Set WSResult = Worksheets("Sheet2") Arr = WSData.Range("C10:AB" & WSData.Cells(Rows.Count, 3).End(xlUp).Row).Value ReDim temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2) - 2) Ar1 = Array("سكر", "أرز", "بطاطس", "عنب") Ar2 = Array("زيادة", "ناقص", "بكثرة", "محتاج") Dim x For I = 1 To UBound(Arr, 1) P = P + 1 For J = 1 To UBound(Arr, 2) - 2 If J < 13 Then temp(P, J) = Arr(I, J) ElseIf J > 22 Then temp(P, J) = Arr(I, J + 2) Else x = Application.Match(Arr(I, J + 1), Ar1, 0) If Not IsError(x) Then temp(P, J) = Ar2(x - 1) temp(P, J + 1) = Arr(I, J + 1) Else temp(P, J) = "مخزن" temp(P, J + 1) = Arr(I, J + 1) End If J = J + 1 End If Next J Next I If P > 0 Then WSResult.Range("C10").Resize(P, UBound(temp, 2)).Value = temp Application.EnableEvents = True Application.ScreenUpdating = True End Sub

وعليكم السلام ورحمه الله وبركاته تفضل هذا التعديل CommandButton1_Click من اجل LastRow1 CommandButton2_Click من اجل LastRow2 Private Sub CommandButton1_Click() Dim LR As Long, X If TextBox1.Value <> "" Then LR = Sheet2.Range("a" & Rows.Count).End(xlUp).Row X = Application.Match("List2", Sheet2.Range("A2:A" & LR), 0) + 1 LR = WorksheetFunction.CountA(Sheet2.Range("A1:A" & X)) If LR = X Then Sheet2.Rows(X).Resize(1).EntireRow.Insert ' Resize(1) عندما تمتلئ القائمه الاولي يضيف العدد بين الاقواس Sheet2.Range("a" & LR).Value = TextBox1.Value TextBox1.Value = "" Else MsgBox ("من فضلك تأكد من ادخال البيانات") End If TextBox1.SetFocus End Sub Private Sub CommandButton2_Click() Dim LR As Long If TextBox1.Value <> "" Then 'And TextBox3.Value <> "" And TextBox4.Value <> "" Then LR = Sheet2.Range("A" & Rows.Count).End(xlUp).Row Sheet2.Range("a" & LR + 1).Value = TextBox1.Value TextBox1.Value = "" Else MsgBox ("من فضلك تأكد من ادخال البيانات") End If End Sub