سليم حاصبيا

جرب هذا الماكرو أو بالأحرى (3 ماكرو) Sub AddValidationCirclesForPrinting() Dim My_cel As Range Dim My_rg As Range Dim My_Count As Integer Dim My_Shape As Shape On Error Resume Next '========================================= For Each My_Shape In Application.ActiveSheet.Shapes If My_Shape.Name Like "InvalidData_*" Then My_Shape.Delete End If Next '==================================== Set My_rg = Application.ActiveSheet.Cells.SpecialCells(xlCellTypeAllValidation) If My_rg Is Nothing Then Exit Sub My_Count = 0 For Each My_cel In My_rg If Not My_cel.Validation.Value Then Set My_Shape = Application.ActiveSheet.Shapes.AddShape(msoShapeOval, My_cel.Left - 1, My_cel.Top - 1, My_cel.Width - 1, My_cel.Height - 1) With My_Shape .Fill.Visible = msoFalse .Line.ForeColor.SchemeColor = 10 .Line.Weight = 1.25 My_Count = My_Count + 1 .Name = "InvalidData_" & My_Count End With End If Next End Sub Sub RemoveValidationCircles() Dim xShape As Shape For Each xShape In Application.ActiveSheet.Shapes If xShape.Name Like "InvalidData_*" Then xShape.Delete End If Next End Sub Sub print_for_me() Answer = InputBox("Do you want to print the red cerles press Y or N", "Salim You Ask", "Y/N") If UCase(Answer) = "N" Then RemoveValidationCircles ActiveSheet.PrintPreview ' ActiveSheet.PrinOut ElseIf UCase(Answer) = "Y" Then AddValidationCirclesForPrinting ActiveSheet.PrintPreview ' ActiveSheet.PrinOut Else MsgBox "Choose Y or N" End If End Sub مرفق ملف كمثال Add_remove_PrintPreview.rar

اخي ياسر صياج الخير والورد والياسمين اعتقد انه هناك طريقة ما للتحكم بحجم هذه الدوائر لجعلها ضمن حدود الخلية Parent (فقد مررت على فيديو بهذا الشأن - لا اذكر العنوان) ما بموضوع الطباعة اعتقد ان هناك خيارات لطباعتها او لا

جرب هذا الملف دون الحاجة الى الضفط على زر بحث يكفي ان تكتب الاسم في الخلية E1 ليقوم اكسل بتحديده(اذا كان الاسم صحيحاً) Private Sub Worksheet_Change(ByVal Target As Range) Range("a5:f100").Interior.ColorIndex = xlNone If Target.Address(0, 0) <> "E1" Then Exit Sub On Error GoTo 1 Range("z1").FormulaArray = "=MATCH(TRIM(E1),TRIM(B5:B100),0)+4" t = Range("z1").Value Range("z1").Clear Cells(t, 1).Resize(1, 6).Interior.ColorIndex = 6 Exit Sub 1: MsgBox "This Name Doesn't Exits" Range("z1").Clear End Sub

احذف الرقم +1 من سطر تعريف iLastRow2

يجب حفظ الملف بعد تنزيل الماكرو بصيغة xlsm شاهد هذا الفيديو

جرب الملف هذا (صفحة Salim) تم اخفاء الاعمدة غير المطلوبة(اذا كنت تريد يمكن حذفها) test salim.rar

أين الاعجاب؟؟!! او ان كبسة زر صعبة قوي

في هذا الجزء من الماكرو غير الرقم 1 (إول رقم و ليس الثاني) الى اي رقم تريدحسب رقم العامود الذي تريد العمل عليه) A=1 B=2 و هكذا If Target.Column = 1 And Target.Count = 1 Then

تفضل PLEASE HELP MEEE salim.rar

جرب هذا الماكرو يعمل فقط في العامودين A & B Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Target.Column = 1 And Target.Count = 1 Then If IsDate(Target.Offset(0, 1)) = False Then MsgBox "Please Enter Only a Date In: " & Target.Offset(0, 1).Address, , "Salim tell you" Target = "" End If Application.EnableEvents = True End If Application.EnableEvents = True End Sub

جرب هذا الكود Sub calcl() Application.ScreenUpdating = False My_max = Application.Max(Sheets("تسوية").Range("a:a")) For i = 13 To My_max Sheets("تسوية").Range("h" & i).Formula = "=IFERROR(SUMPRODUCT(SUMIF(INDIRECT(""'""&$L$2:$W$2&""'!$B$13:$B$262""),$C13,INDIRECT(""'""&$L$2:$W$2&""'!""&CHAR(COLUMNS($A$1:A1)+70)&""$13:""&CHAR(COLUMNS($A$1:A1)+70)&""$262""))),"""")" Sheets("تسوية").Range("h" & i).AutoFill Destination:=Range("h" & i & ":z" & i), Type:=xlFillDefault Next Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub

خطأ مطبعي ليس الا المهم النتيجة عذراً

لعل هذه المقصودة =IFERROR(INDEX($A$2:$D$50,SMALL(IF($A$2:$A$50<>"",IF($A$2:$A$50>=$G$1,IF($A$2:$A$50<=$G$2,IF(INDEX($C$2:$D$50,,MATCH($K$1,$C$1:$D$1,0))<>0,ROW($A$2:$A$50)-ROW($A$2)+1)))),ROWS($I$2:I11)),MATCH(I$1,$A$1:$D$1,0)),"")

جرب هذه المعادلة Ctrl+shift+Enter واسحب المعادلة يساراً حتى K2 و نزولاً حتى K50 =IFERROR(INDEX($A$2:$D$50,SMALL(IF($A$2:$A$50<>"",IF($A$2:$A$50>=$G$1,IF($A$2:$A$50<=$G$2,IF($C$2:$C$50<>"",IF(INDEX($C$2:$D$50,,MATCH($K$1,$C$1:$D$1,0))<>0,ROW($A$2:$A$50)-ROW($A$2)+1))))),ROWS($I$2:I2)),MATCH(I$1,$A$1:$D$1,0)),"")

السؤال في مفهوم هل تريد تسخ البيانات ام ترحيلها (هذا اولاُ) ثانياً ما هي الشروط (حسب المادة حسب المبالغ حسب التاريخ الخ...)

تفضل اخي خالد 1salim.rar

لا احد يعمل مع صورة ارفع الملف(او جزء منه 20سطر على الاكثر) للعمل عليه

تم معالجة الامر Emploi salim Hidden.rar

الحمدلله الذي به تتم الصالحات على فكرة اين الاعجاب؟ او ان كبسة زر صعبة أوي

جرب هذا الملف نقل بدون تكرار مع الترتيب salim.rar

تقضل هذا الملف يجب التشغيل على 2007 و ما فوق 1-الزر Single recorde يقوم يتغيير سجل واحد (الذي انت تحدده من العامود الاخضر) تكتب القيمة في الخلية (العامود الاخضر بين 28 و 39) اكثر من ذلك يستغرق وقت طويل للحساب ثم تضفط على الزر (لا يعمل الماكرو اذا لم تكن الخلية المحددة في العامود M ) (لا يعمل الماكرو اذا تم تحديد اكثر من خلية واحدة ) (لا يعمل الماكرو اذا كانت قيمة الخلية اقل من 28 او اكثر من 39 ) 2- الزر All recordes لتغيير كافة البيانات في حال اخذ الماكرو وقتا طويلاُ (اكثر من 3 دقائق )هذا يعني انه لا يوجد حل لاحد الحالات حسب الشروط المعطية عندها يجب توقيف الماكرو عن العمل بالضغط على Ctrl+Pause من لوحة المفاتيح المفتاح Pause موجود أعلى مفتاح PageUp كشف تجميعي salim2.rar

اشرح منطقياً ما المقصود من المعادلة

استبدل CHOOSE(($K$1=$D$1 الحرف D يالحرف C و ذلك في الخلية I2 بعد ذلك Ctrl+shift+Enter واسحب المعادلة يساراً حتى K2 و نزولاً حتى K50 لا تنس تنسيق الخلايا في العامودين J & K الى General

ربما هذا المطلوب الصفحة 3 اضابير salim2.rar

اذا كنت قد فهمت صحيحاً فهذا المطلوب الصفحة الثانية اضابير salim1.rar