أبوأحـمـد

وعليكم السلام ورحمة الله وبركاته بعيدا عن التعقيد وتكرار البيانات عملت لك فلتر في ورقة البيانات وبعد تعديل البيانات تضغط زر حفظ التعديل فيلتغي الفلتر وبالتالي النتيجة واحدة أرجو أن يؤدي المطلوب هذي كل الأكواد Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B1")) Is Nothing Then Range("A2:APL2").AutoFilter Field:=21, Criteria1:=Range("B1") End If End Sub Sub e() Range("A2:APL2").AutoFilter Field:=21 End Sub نسخ البيانات - الى الرئيسية .xlsb

وعليكم السلام ورحمة الله وبركاته تفضل ترحيل النتائج (1).xlsm

لم تضف الكود كاملا نسيت هذا ضعه في الموديول Module Function fnd2(n As Long, s As Long) Dim ItemRow As Integer ItemRow = WorksheetFunction.Match(n, Sheet1.Range("A1:A99999"), 0) If ItemRow = Empty Then Beep: Exit Function fnd2 = Sheet1.Range("S" & ItemRow).Value - s End Function

اقرأ الكود جيدا أو على الأقل جرب البرنامج أضفت لك في الكود البرمجي أشياء أصل لم تطلبها لمنع التسجيل عدم تحديد كود الصنف عدم كتابة عدد القطع بالإضافة إلى هل الرصيد كافي Exit Sub تعني اخرج من الإجراء

وعليكم السلام تمت الإجابة على هذا السؤال أكثر من مرة وبعدة طرق حسب طلبك ولكن يبدوا أنك لا تتابع مواضيعك اظهار رسالة عند عدم وجود مخزون

هذا الكود سيلغي الدمج وينسخ قيمة الخلية اللي فوقها Sub UnMergeFill() Dim cell As Range, joinedCells As Range For Each cell In ThisWorkbook.ActiveSheet.UsedRange If cell.MergeCells Then Set joinedCells = cell.MergeArea cell.MergeCells = False joinedCells.Value = cell.Value End If Next End Sub

تفضل التحاليل الطبية.xlsx

وعليكم السلام تفضل =IF(MOD(A2;50)=1;B1+1;B1) المصنف-50.xlsx

تفضل _عملاء 2023م - نسخة.xlsb

ضع هذا التعديل على دالة الأستاذ محمد لتدعم الصفيف أو اضغط شيفت+ كنترول + انتر =INDEX('m cost'!$E$3:$E$1062;MATCH(1;INDEX((('m cost'!$B$3:$B$1062=C3)*('m cost'!$C$3:$C$1062=O3)*('m cost'!$D$3:$D$1062=N3));0);0))

تفضل _العملاء- 2023م - نسخة.xlsb

وعليكم السلام ورحمة الله وبركاته الحل قبل الحذف فك حماية الورقة وحمايتها مرة أخرى بعد الحذف فك الحماية ActiveSheet.unprotect Password:="123" إعادة الحماية ActiveSheet.protect Password:="123" مع مراعاة رقم الحماية الخاص بك بدل 123

وعليكم السلام قد يفيدك أحد الموضوعين التقويم الدراسي والمواعيد وتنظيم الأعمال والمشاريع هدية للأعضاء والزوار تقويم أم القرى المميزالاصدار الأول

هذا الملف جاهز والفلتر شغال الى أكثر من 10000 سجل _العملاء- 2023م - نسخة.xlsb

أخي ليش كل ما أعدل لك الكود تقوم تحوس فيه وتخربه

رصيد الافتتاح يجب أن يكون بعيدا عن رأس الجدول _العملاء 2023م - نسخة.xlsb

يجب إزالة الصف المدموج خلية (رصيد الافتتاح)

نسق الخلية الى رقم أو عملة

أخي عبدالله يفضل أي سؤال آخر تفتح له موضوع جديد حسب سياسية المنتدى مع توضيح المطلوب ، فالأرقام المتوقع التي كتبت لا يمكن استخراجها بأي معادلة حسب ما أعرف

ربما بعض الأرقام بالمفتاح الدولي وبعضها بدونه وللتأكد دعنا نجرب مثلا آخر 6 أرقام من خلال هذه المعادلة على فرض أن الأرقام في العمود A1 ونازل ضع هذه المعادلة بالخلية B1 اسحب لأسفل ناتج المعادلة الطبيعي 1 وما زاد هو عدد التكرار =SUMPRODUCT(((RIGHT($A1:$A$1;6))=(RIGHT(A1;6)))*1)

تفضل Private Sub Worksheet_Change(ByVal Target As Range) Dim myRange As Range Dim x As Long Set myRange = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row + 1) If Target.CountLarge > 1 Then Exit Sub If Intersect(Target, myRange) Is Nothing Then Exit Sub If InStr(2, Target, " ") > 0 Then Target.WrapText = True Else Target.WrapText = False Target.ShrinkToFit = True End If Target.EntireRow.AutoFit End Sub

وعليكم السلام تفضل Sub TR7EL() Dim W1, W2 As Worksheet Dim R, C, x As Long Set W1 = Worksheets("الجرد ") Set W2 = Worksheets("النموذج المالي") C = 1 R = 8 For x = 6 To Cells(Rows.Count, "F").End(xlUp).Row If W1.Range("S" & x) > 0 Then W2.Range("B" & R) = W1.Range("E" & x) W2.Range("C" & R) = W1.Range("F" & x) W2.Range("D" & R) = W1.Range("D" & x) W2.Range("E" & R) = W1.Range("C" & x) W2.Range("F" & R) = "" W2.Range("G" & R) = W1.Range("T" & x) W2.Range("H" & R) = W1.Range("U" & x) W2.Range("I" & R) = W1.Range("V" & x) W2.Range("J" & R) = W1.Range("W" & x) W2.Range("K" & R) = W1.Range("X" & x) W2.Range("L" & R) = W1.Range("Y" & x) W2.Range("M" & R) = W1.Range("Z" & x) If C = 15 Then R = R + 13 C = 1 Else R = R + 1 C = C + 1 End If End If Next End Sub

نفس معادلة الأستاذ أحمد الفرق = & <> 😀

وعليكم السلام ورحمة الله وبركاته تفضل Sub test() Dim x As Long For x = 1 To Cells(Rows.Count, "A").End(xlUp).Row If InStr(2, Range("A" & x), " ") > 0 Then Range("A" & x).WrapText = True Else Range("A" & x).WrapText = False Range("A" & x).ShrinkToFit = True End If Range("A" & x).EntireRow.AutoFit Next End Sub

معذرة أخي المطلوب غير واضح هل تريد إذا اخترت شهر 2 مثلا تكون النتيجة 351 وشهر 7 تكون النتيجة 610 وهكذا بقية الأشهر إذا لم يكن هذا هو المطلوب أرجو التوضيح أكثر وذكر النتائج المتوقعة