Emad Karali

للرفع

اخي سليم المشكلة ليست في هذا الكود Auto_sum ولافي Sell و Buy و Close ل ولافي النتائج المشكلة في هذا الكود Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Not Intersect(Target, Range("$C$4:$H$43", "$K$4:$O$43")) Is Nothing _ And Target.Count = 1 Then Emad End If Application.EnableEvents = True End Sub هذا الكود لايتحدث تلقائي يجب انا اكتب بنفسي في الخلية لكي يتحدث ولاكن لااريد انا اكتب اريد الكود يتحدث تلقائي كل م تغير الارقام بسبب المعادلات الموجودة هنا ("Range("$C$4:$H$43" ( المعادلات والصيغ تقراء من ملف اخر باستمرار تتغير يمكن كل جزء من الثانية يتغير رقم ) وانا اريد في الصفحة Sheet2 يحدث تلقائي ويكتب Sell و Buy و Close بدون م اكتب شي بنفسي لكي يتحدث الكود ,,,, يعني اريد يتعرف الكود على الخلاية ("Range("$C$4:$H$43" وكل م تغير رقم واحد بسبب نواتج المعادلات والصيغ يتحدث الكود ويكتب حسب الشروط Sell و Buy و Close اتمنى اكون شرحة تمام

استاذ سليم حاصبيا لما اطبق الكود ىدون م احذف value يكتب لي في الخلية المطلوب زي الصوره ولاكن لايتحدث تلقائي ىبعد حذف value مثل م قلت لايكتب لي المطلوب ولاكن يكتب الصيغة الي موجودة في الكود بكده م يحتاج يتحدث تلقائي لان الكود انكتب في الخلية وماراح يتعرف على الخلية البرنامج الخارجي لان ضروري م يكون فيه غير Sell و Buy و Close لااجل يتعرف عليه اتمنى مساعدتك Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Application.EnableEvents = False If Not Intersect(Target, Range("$C$4:$H$43", "$K$4:$O$43")) Is Nothing _ And Target.Count = 1 Then Emad End If Application.EnableEvents = True End Sub Sub Emad() Dim H% With Sheets("Main") H = .Cells(Rows.Count, "H").End(3).Row With .Range("k4:k" & H) .Formula = _ "=IF(C4="""","""",IF(AND(C4<=0,D4>=0,F4<=0,G4<=0,H4<=-15,M4<=-13),""Sell"",""""))" End With With .Range("L4:L" & H) .Formula = _ "=IF(C4="""","""",IF(AND(F4<=0,G4<=0,H4<=-15,M4<=-8),""Wait"",""Close""))" End With With .Range("N4:N" & H) .Formula = _ "=IF(C4="""","""",IF(AND(F4>=0,G4>=0,H4>=15,M4>=8),""Wait"",""Close""))" End With With .Range("o4:o" & H) .Formula = _ "=IF(C4="""","""",IF(AND(F4>=0,G4>=0,H4>=15,M4>=13),""Buy"",""""))" End With End With End Sub قاها ، او اختر ملف... اضف مرفقات اخري امتدادات الصور المسموح بها: zip, rar, jpg, gif, bmp, png, pdf, tif, jpeg, doc, docx, docxm, xls, xlm, xlsx, xlsm, ppt, pptx, pptm, pps, ppsm, ppsx, accdb, mdb, mpp, 7z, xlsb, docm الحد الاقصي: 967.9 kB صور مرفوعه التقاط.JPG 12.61 kB التقاط1.JPG 19.5 kB

اخي الفاضل اشكر لك مجهودك الذي تقدمه للخير اعلم انني اخذت من وقتك وتعبتك معايا الكود ممتاز واشتغل تلقائي لاكن لايتفعل الى اذا كتبت في اي خلية اريد المعادلات في الخلايا هيا الي تشغل الكود تلقائي لااني رابط الملف بملف خارجي ياخذ البيانات منها وانا لااكتب شي ابدا ... اشكرك

Private Sub Worksheet_Change(ByVal Target As Range) Dim H% With Sheets("Sheet2") H = .Cells(Rows.Count, "H").End(3).Row .Range("k2:k" & H).Formula = _ "=IF(AND(C2<=0,D2>=0,F2<=0,G2<=0,H2<=-15,M2<=-13),""Sell"","""")" .Range("k2:k" & H).Value = _ .Range("k2:k" & H).Value .Range("L2:L" & H).Formula = _ "=IF(AND(F3<=0,G3<=0,H3<=-15,M3<=-8),""Wait"",""Close"")" .Range("L2:L" & H).Value = _ .Range("L2:L" & H).Value .Range("N2:N" & H).Formula = _ "=IF(AND(F2>=0,G2>=0,H2>=15,M2>=8),""Wait"",""Close"")" .Range("N2:N" & H).Value = _ .Range("N2:N" & H).Value End With End Sub عندما اكتب الكود بدخل حدث الصفحة يعلق الاكسل ويقفل اريد ان يكون تلقائي :,(

اخي الملف جدا ممتاز اشكرك ولاكن ينقصه شي واحد فقط ان يكون تلقائي بدون زر

تمام ي غالي اعتذر على عدم اضافة الملف المرفق هذا الملف ليس الاصلي لاان الاصلي مربوط بملف اخر ف البيانات بتجي مكانها Error يوجد معادلات داخل الخلاية وليست موجودة داخل هذا الملف واريد الكود يتعرف على المعادلات .. وشكرا على المساعدة Private Sub Worksheet_Change(ByVal Target As Range) Dim RowNum, r, s, n As Long For RowNum = 2 To 40 If Worksheets("Sheet2").Cells(RowNum, 3).Value <= 0 And Worksheets("Sheet2").Cells(RowNum, 4).Value >= 0 And Worksheets("Sheet2").Cells(RowNum, 6).Value <= 0 And Worksheets("Sheet2").Cells(RowNum, 7).Value <= 0 And Worksheets("Sheet2").Cells(RowNum, 8).Value <= -15 And Worksheets("Sheet2").Cells(RowNum, 13).Value <= -13 Then Worksheets("Sheet2").Cells(RowNum, 11).Value = "SELL" End If Next RowNum For r = 2 To 40 If Worksheets("Sheet2").Cells(r, 6).Value <= 0 And Worksheets("Sheet2").Cells(r, 7).Value <= 0 And Worksheets("Sheet2").Cells(r, 8).Value <= -15 And Worksheets("Sheet2").Cells(r, 13).Value <= -8 Then Worksheets("Sheet2").Cells(r, 12).Value = "WAIT" Else Worksheets("Sheet2").Cells(r, 12).Value = "CLOSE" End If Next r For s = 2 To 40 If Worksheets("Sheet2").Cells(s, 6).Value >= 0 And Worksheets("Sheet2").Cells(s, 7).Value >= 0 And Worksheets("Sheet2").Cells(s, 8).Value >= 15 And Worksheets("Sheet2").Cells(s, 13).Value >= 8 Then Worksheets("Sheet2").Cells(s, 14).Value = "WAIT" Else Worksheets("Sheet2").Cells(s, 14).Value = "CLOSE" End If Next s For n = 2 To 40 If Worksheets("Sheet2").Cells(n, 3).Value >= 0 And Worksheets("Sheet2").Cells(n, 4).Value <= 0 And Worksheets("Sheet2").Cells(n, 6).Value >= 0 And Worksheets("Sheet2").Cells(n, 7).Value >= 0 And Worksheets("Sheet2").Cells(n, 8).Value >= 15 And Worksheets("Sheet2").Cells(n, 13).Value >= 13 Then Worksheets("Sheet2").Cells(n, 15).Value = "BUY" Else Worksheets("Sheet2").Cells(n, 15).Value = " " End If Next n End Sub اطلب من اخواني الكرام تعديل الكود تعبت اعدل فيه اريده يقراء من خلية يوجد بها معادلة واريده ان يكون تلقائي بدون زر لو تكرمتم نسخة من اوفيسنا.xlsm

اخي خيماوي اتمنى تنظر لموضوعي محتاج جدا الكود

Private Sub Worksheet_Change(ByVal Target As Range) Dim RowNum, r, s, n As Long For RowNum = 2 To 40 If Worksheets("Sheet2").Cells(RowNum, 3).Value <= 0 And Worksheets("Sheet2").Cells(RowNum, 4).Value >= 0 And Worksheets("Sheet2").Cells(RowNum, 6).Value <= 0 And Worksheets("Sheet2").Cells(RowNum, 7).Value <= 0 And Worksheets("Sheet2").Cells(RowNum, 8).Value <= -15 And Worksheets("Sheet2").Cells(RowNum, 13).Value <= -13 Then Worksheets("Sheet2").Cells(RowNum, 11).Value = "SELL" End If Next RowNum For r = 2 To 40 If Worksheets("Sheet2").Cells(r, 6).Value <= 0 And Worksheets("Sheet2").Cells(r, 7).Value <= 0 And Worksheets("Sheet2").Cells(r, 8).Value <= -15 And Worksheets("Sheet2").Cells(r, 13).Value <= -8 Then Worksheets("Sheet2").Cells(r, 12).Value = "WAIT" Else Worksheets("Sheet2").Cells(r, 12).Value = "CLOSE" End If Next r For s = 2 To 40 If Worksheets("Sheet2").Cells(s, 6).Value >= 0 And Worksheets("Sheet2").Cells(s, 7).Value >= 0 And Worksheets("Sheet2").Cells(s, 8).Value >= 15 And Worksheets("Sheet2").Cells(s, 13).Value >= 8 Then Worksheets("Sheet2").Cells(s, 14).Value = "WAIT" Else Worksheets("Sheet2").Cells(s, 14).Value = "CLOSE" End If Next s For n = 2 To 40 If Worksheets("Sheet2").Cells(n, 3).Value >= 0 And Worksheets("Sheet2").Cells(n, 4).Value <= 0 And Worksheets("Sheet2").Cells(n, 6).Value >= 0 And Worksheets("Sheet2").Cells(n, 7).Value >= 0 And Worksheets("Sheet2").Cells(n, 8).Value >= 15 And Worksheets("Sheet2").Cells(n, 13).Value >= 13 Then Worksheets("Sheet2").Cells(n, 15).Value = "BUY" Else Worksheets("Sheet2").Cells(n, 15).Value = " " End If Next n End Sub لما يشتغل يكتب المطلوب ولاكن بعدها يطلع لي هذا الخطا وفي مشكلة الخلاية فيها معادلات م يشتغل الكود

شكرا اخي خيماوي ممتاز لاكن هذا بزر وانا اريده تلقائي بدون م اضغط زر الله يجزاك خير

عندي جدول كاتب فيه دالة عند تحقق شروط في الخمسة الخلايا الي قبل يكتب لي اما شراء او بيع او اغلاق ولاكن مجبور اني احول الدالة الى كود لاان عندي ملف خارجي يقراء فقط الدالة ولايقراء المكتوب في الخلية الي هوا الناتج من الدالة اريد فقط لو تكرمتم تحويل الدالة الى كود تلقائي في نفس الشيت بحثت في الموقع عن موضوع ولم اجد شي قريب كتبت كود نجح معايا ولاكن فقط لصف واحد وانا اريد الصفوف كاملة اريد تغير بسيط اني اريد حذف عاموديناوفيسنا.xls الاغلاق واترك فقط عامود البيع والشراء وعند تحقق شرط الشراء يكتب شراء ولا تتغير الى اغلاق الى اذا تحقق شرط الاغلاق وكذلك في عامود البيع تركت العامود لااجل الدالة تتعرفو عليها باذن الله مافي شي صعب عليكم اتمنى مساعدتكم اوفيسنا.xls

ممكن احد يساعدني ولو بشي بسيط الله يجزاكم خير

يتابع :(

بحثت في المنتدى م حصلت نفس الي ابغاه اتمنى تساعدوني في هذا الكود وربي محتاجه ضروري

عندي ملفين واحد HISTORY وواحد Le كل شي جاهز فقط اريد تعديل كود الترحيل واستعادة البيانات في ملف Le من ملف HISTORY وهو مغلق اتمنى مساعدتكم الرقم السري للاكواد 1111 Le.rar