طلب من اخواني الكرام تعديل الكود

[Emad Karali]

تمام ي غالي اعتذر على عدم اضافة الملف المرفق

هذا الملف ليس الاصلي لاان الاصلي مربوط بملف اخر ف البيانات بتجي مكانها 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

[سليم حاصبيا]

لا يمكن العمل بدون ملف مرفق

فعلى ماذا تريد نجربة الماكرو؟؟؟؟

ثم لماذا لا تكتب الكود بشكل يمكن قرائته يسهولة

مثلاً هذا الجزء منه

 For RowNum = 2 To 40
       With Worksheets("Sheet2").Cells(RowNum, 3)
            If .Value <= 0 _
               And .Offset(, 1) >= 0 _
               And .Offset(, 3) <= 0 _
               And .Offset(, 4) <= 0 _
               And .Offset(, 5) <= -15 _
               And .Offset(, 10) <= -13 Then
    
               .Offset(, 8) = "SELL"
             End If
        End With
    Next RowNum

 

 

[سليم حاصبيا]

الكود المطلوب

تم ازالة الالوان الفاقعة  لسهولة النظر الى الملف (بمكنك اعادنها) أو نسخ الكود الى ملفك

Option Explicit
Sub Auto_sum()
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

الملف مرفق

Emad.xlsm

[Emad Karali]

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

[Emad Karali]

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

عندما اكتب الكود بدخل حدث الصفحة يعلق الاكسل ويقفل اريد ان يكون تلقائي :,(

[سليم حاصبيا]

هذا تلقائي

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
 Application.EnableEvents = False
  If Not Intersect(Target, Range("$C$2:$H$40", "$K$2:$O$40")) Is Nothing _
   And Target.Count = 1 Then
   Auto_sum
 End If
 Application.EnableEvents = True
End Sub
'+++++++++++++++++++++++++++++++++++++++++++++++
Sub Auto_sum()
Dim H%

With Sheets("Sheet2")
    H = .Cells(Rows.Count, "H").End(3).Row
   With .Range("k2:k" & H)
     .Formula = _
      "=IF(C2="""","""",IF(AND(C2<=0,D2>=0,F2<=0,G2<=0,H2<=-15,M2<=-13),""Sell"",""""))"
     .Value = .Value
   End With
   
   With .Range("L2:L" & H)
    .Formula = _
     "=IF(C2="""","""",IF(AND(F2<=0,G2<=0,H2<=-15,M2<=-8),""Wait"",""Close""))"
      .Value = .Value
   End With
    
    With .Range("N2:N" & H)
    .Formula = _
     "=IF(C2="""","""",IF(AND(F2>=0,G2>=0,H2>=15,M2>=8),""Wait"",""Close""))"
     .Value = .Value
    End With
     
 End With
End Sub

الملف من جديد

Emad_1.xlsm

[Emad Karali]

اخي الفاضل اشكر لك مجهودك الذي تقدمه للخير 

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

[سليم حاصبيا]

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

[سليم حاصبيا]

في هذه الحالة لا أفهم ما هي الحاجة للكود ( اذا كنت تريد المعادلة وليس نتيحتها اكتب المعادلات  فوراً في الخلابا)

طالما الاكسل يفوم وحده بحساب المعادلات مع كل تغيير في الخلايا

[Emad Karali]

استاذ سليم حاصبيا

لما اطبق الكود ىدون م احذف 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

تم تعديل ديسمبر 21, 2020 بواسطه Emad Karali

[سليم حاصبيا]

تم التعديل على الكود 
1- تضع في الخلية   R6 القيمة Sell

2- تضع في الخلية  R7  القيمة Wait

3- تضع في الخلية  R8  القيمة Cllose

و هكذا كلما غيرت شيئا في  R6 أو  R7 أو  R8 تتغير النتائج

كما في الصورة

 

Sub Auto_sum()
Dim H%

With Sheets("Sheet2")
    H = .Cells(Rows.Count, "H").End(3).Row
  
  .Range("k2:k" & H).Formula = _
     "=IF(C2="""","""",IF(AND(C2<=0,D2>=0,F2<=0,G2<=0,H2<=-15,M2<=-13),$R$6,""""))"
  
   .Range("L2:L" & H).Formula = _
     "=IF(C2="""","""",IF(AND(F2<=0,G2<=0,H2<=-15,M2<=-8),$R$7,$R$8))"
       
    
  .Range("N2:N" & H).Formula = _
     "=IF(C2="""","""",IF(AND(F2>=0,G2>=0,H2>=15,M2>=8),$R$7,$R$8))"

 End With
End Sub

الصورة

[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

اتمنى اكون شرحة تمام 

[Emad Karali]

للرفع