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

Emad Karali · ديسمبر 20, 2020

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

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

**سليم حاصبيا** · ديسمبر 20, 2020

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

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

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

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

 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

**سليم حاصبيا** · ديسمبر 20, 2020

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

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

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 · ديسمبر 20, 2020

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

Emad Karali · ديسمبر 20, 2020


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

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

**سليم حاصبيا** · ديسمبر 20, 2020

هذا تلقائي

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 · ديسمبر 20, 2020

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

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

**سليم حاصبيا** · ديسمبر 20, 2020

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

**سليم حاصبيا** · ديسمبر 20, 2020

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

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

Emad Karali · ديسمبر 21, 2020

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

لما اطبق الكود ىدون م احذف value يكتب لي في الخلية المطلوب زي الصوره ولاكن لايتحدث تلقائي

1285975565_.JPG.1295fd731de801f4df092e8589e7ef85.JPG

ىبعد حذف value مثل م قلت لايكتب لي المطلوب ولاكن يكتب الصيغة الي موجودة في الكود 844418793_1.JPG.ff87613657064cb14d8bb4c833f364be.JPG

بكده م يحتاج يتحدث تلقائي لان الكود انكتب في الخلية وماراح يتعرف على الخلية البرنامج الخارجي لان ضروري م يكون فيه غير 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

320405802_.png.db6e5990449469806fe7c4a40af44f17.png

قاها ، او اختر ملف...
اضف مرفقات اخري

امتدادات الصور المسموح بها: 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

**سليم حاصبيا** · ديسمبر 21, 2020

تم التعديل على الكود
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 · ديسمبر 21, 2020

اخي سليم المشكلة ليست في هذا الكود 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 · ديسمبر 23, 2020

للرفع

تسجيل الدخول

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

الردود الموصى بها

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

التقاط.JPG

التقاط1.JPG

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

رابط هذا التعليق

شارك

Join the conversation

تصفح هذا الموضوع مؤخراً 0 اعضاء متواجدين الان

Important Information