اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

اختصار كود

ابو حمادة

بواسطه ابو حمادة
في منتدى الاكسيل Excel

 مشاركة

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

ابو حمادة

ابو حمادة

قام بنشر
قام بنشر

السلام عليكم ورحمة الله تعالى وربركاته

كل عام وانتم بخير بمناسبه حلول شهر رمضان المعظم اعاده الله علينا وعليكم وعلى امة المسلمين باليمن والخير والبركات

استفسار

1- لدى ملف به عدد اعمده كثيره جدا وصفوف تتخطي 10 الاف صف

الكود يعمل كما اريد ولكن الكود طويل جدا وبياخد وقت فى تنفيذ الكود

عمل الكود عباره عن اذا تحقق الشرط يتم مسح بيانات الصف باكمله ماعدي بعض الاعمده  لها عمليات حسابيه

هل من الممكن اختصار الكود المرفق لكي ينفذ ما اريد بسرعه افضل من هذا 

Sub Click3() 
On Error GoTo 1
    
    Dim ws As Worksheet: Set ws = Sheets("add")
    Dim N, C2 As Range
      '   On Error Resume Next
For Each N In ws.Range("H6:H" & ws.Range("B" & Rows.Count).End(xlUp).Row)
  
  If N.Value = "محمود" Or N.Value = "احمد" Then
           Application.ScreenUpdating = False

    N.Offset(0, 111) = "" 
    N.Offset(0, 112) = "" 
    N.Offset(0, 113) = "" 
    N.Offset(0, 114) = "" 
    N.Offset(0, 115) = "" 
    N.Offset(0, 116) = "" 

'    N.Offset(0, 117) = "" 
    N.Offset(0, 118) = Format(Round(N.Offset(0, 171) + N.Offset(0, 172) + N.Offset(0, 173) + N.Offset(0, 174), 2)) 
    
    N.Offset(0, 119) = "" ''
    N.Offset(0, 120) = "" ''
    N.Offset(0, 121) = "" ''
    N.Offset(0, 122) = "" ''
    N.Offset(0, 123) = "" ''
    N.Offset(0, 124) = "" ''
    N.Offset(0, 125) = "" ''
    N.Offset(0, 126) = "" ''
    N.Offset(0, 127) = "" ''
    N.Offset(0, 128) = "" ''
    N.Offset(0, 129) = "" ''
    N.Offset(0, 130) = "" ''
    N.Offset(0, 131) = "" ''
    N.Offset(0, 132) = "" ''
    N.Offset(0, 133) = "" ''
    N.Offset(0, 134) = "" ''
    N.Offset(0, 135) = "" ''
    N.Offset(0, 136) = "" ''
    N.Offset(0, 137) = "" ''
    N.Offset(0, 138) = "" ''
    N.Offset(0, 139) = "" ''
    N.Offset(0, 140) = "" ''
    N.Offset(0, 141) = "" ''
    N.Offset(0, 142) = "" ''
    N.Offset(0, 143) = "" ''
    N.Offset(0, 144) = "" ''
    N.Offset(0, 145) = "" ''
    N.Offset(0, 146) = "" ''
    N.Offset(0, 147) = "" ''
    N.Offset(0, 148) = "" ''
    N.Offset(0, 149) = "" ''
    N.Offset(0, 150) = "" ''
    N.Offset(0, 151) = "" ''
    N.Offset(0, 152) = "" ''
    N.Offset(0, 153) = "" ''
    N.Offset(0, 154) = "" ''
    N.Offset(0, 155) = "" ''
    N.Offset(0, 156) = "" ''
    N.Offset(0, 157) = "" ''
    N.Offset(0, 158) = "" ''
    N.Offset(0, 159) = "" ''
    N.Offset(0, 160) = "" ''
    N.Offset(0, 161) = "" ''
    N.Offset(0, 162) = "" ''
    N.Offset(0, 163) = "" ''


'    N.Offset(0, 164) = "" 
    N.Offset(0, 165) = Format(Round(N.Offset(0, 180) + N.Offset(0, 181), 2))  
    
    N.Offset(0, 166) = "" ''
    N.Offset(0, 167) = "" ''
    N.Offset(0, 168) = "" ''
    N.Offset(0, 169) = "" ''

    
    N.Offset(0, 175) = "" ''
    N.Offset(0, 177) = "" ''
    N.Offset(0, 178) = "" ''
    N.Offset(0, 179) = "" ''
    
'    N.Offset(0, 180) = "" ''
'    N.Offset(0, 181) = "" ''
    N.Offset(0, 182) = "" ''
'    N.Offset(0, 183) = "" ''
    N.Offset(0, 184) = "" ''
    N.Offset(0, 185) = "" ''
    N.Offset(0, 186) = "" ''
    N.Offset(0, 187) = "" ''
    N.Offset(0, 188) = "" ''
    N.Offset(0, 189) = "" ''
    
    N.Offset(0, 190) = "" ''
    N.Offset(0, 191) = "" ''
    N.Offset(0, 192) = "" ''
    N.Offset(0, 193) = "" ''
    N.Offset(0, 194) = "" ''
    N.Offset(0, 195) = "" ''
    N.Offset(0, 196) = "" ''
    N.Offset(0, 197) = "" ''
    N.Offset(0, 198) = "" ''
    N.Offset(0, 199) = "" ''
    
    N.Offset(0, 200) = "" ''
    N.Offset(0, 201) = "" ''
    N.Offset(0, 202) = "" ''
    N.Offset(0, 203) = "" ''
    N.Offset(0, 204) = "" ''
    N.Offset(0, 205) = "" ''
    N.Offset(0, 206) = "" ''
    N.Offset(0, 207) = "" ''
    N.Offset(0, 208) = "" ''
    N.Offset(0, 209) = "" ''
    
    N.Offset(0, 210) = "" ''
    N.Offset(0, 211) = "" ''
    N.Offset(0, 212) = "" ''
    N.Offset(0, 213) = "" ''
    N.Offset(0, 214) = "" ''
    N.Offset(0, 215) = "" ''
    N.Offset(0, 216) = "" ''
    N.Offset(0, 217) = "" ''
    N.Offset(0, 218) = "" ''
    N.Offset(0, 219) = "" ''
    
    N.Offset(0, 220) = "" ''
    N.Offset(0, 221) = "" ''
    N.Offset(0, 222) = "" ''
    N.Offset(0, 223) = "" ''
    N.Offset(0, 224) = "" ''
    N.Offset(0, 225) = "" ''
    N.Offset(0, 226) = "" ''
    N.Offset(0, 227) = "" ''
    N.Offset(0, 228) = "" ''
    N.Offset(0, 229) = "" ''
    
    N.Offset(0, 230) = "" ''
    N.Offset(0, 231) = "" ''
    N.Offset(0, 232) = "" ''
    N.Offset(0, 233) = "" ''
    N.Offset(0, 234) = "" ''
    N.Offset(0, 235) = "" ''
    N.Offset(0, 236) = "" ''
    N.Offset(0, 237) = "" ''
    N.Offset(0, 238) = "" ''
    N.Offset(0, 239) = "" ''

    N.Offset(0, 240) = "" ''
    N.Offset(0, 241) = "" ''
    N.Offset(0, 242) = "" ''
    N.Offset(0, 243) = "" ''
    N.Offset(0, 244) = "" ''
    N.Offset(0, 245) = "" ''
    N.Offset(0, 246) = "" ''
    N.Offset(0, 247) = "" ''
    N.Offset(0, 248) = "" ''
    N.Offset(0, 249) = "" ''
    
    N.Offset(0, 250) = "" ''
    N.Offset(0, 251) = "" ''
    N.Offset(0, 252) = "" ''
    N.Offset(0, 253) = "" ''
    N.Offset(0, 254) = "" ''
    N.Offset(0, 255) = "" ''
    N.Offset(0, 256) = "" ''

End If
Next
      Application.ScreenUpdating = True

1 End Sub

وجزاكم الله خيرا

رابط هذا التعليق
شارك
سليم حاصبيا

سليم حاصبيا

قام بنشر
قام بنشر

اختصار الكود 

Option Explicit

Sub Click3()

 Application.ScreenUpdating = False

On Error GoTo 1
    
    Dim ws As Worksheet: Set ws = Sheets("add")
    Dim N, C2 As Range
    Dim I%
      '   On Error Resume Next
For Each N In ws.Range("H6:H" & ws.Range("B" & Rows.Count).End(xlUp).Row)
  
  If N.Value = "محمود" Or N.Value = "احمد" Then
     For I = 111 To 256
      If I = 117 Or I = 164 Or I = 183 Then I = I + 1
      If I = 180 Then I = I + 2
       N.Offset(0, I) = vbNullString
   Next
   End If
      N.Offset(0, 165) = Format(Round(N.Offset(0, 180) + N.Offset(0, 181), 2))
 Application.ScreenUpdating = True
   
1 End Sub

 

  • Like 2
رابط هذا التعليق
شارك
ابو حمادة

ابو حمادة

قام بنشر
  • الكاتب
قام بنشر
في ١‏/٦‏/٢٠١٨ at 05:16, سليم حاصبيا said:

اختصار الكود 


Option Explicit

Sub Click3()

 Application.ScreenUpdating = False

On Error GoTo 1
    
    Dim ws As Worksheet: Set ws = Sheets("add")
    Dim N, C2 As Range
    Dim I%
      '   On Error Resume Next
For Each N In ws.Range("H6:H" & ws.Range("B" & Rows.Count).End(xlUp).Row)
  
  If N.Value = "محمود" Or N.Value = "احمد" Then
     For I = 111 To 256
      If I = 117 Or I = 164 Or I = 183 Then I = I + 1
      If I = 180 Then I = I + 2
       N.Offset(0, I) = vbNullString
   Next
   End If
      N.Offset(0, 165) = Format(Round(N.Offset(0, 180) + N.Offset(0, 181), 2))
 Application.ScreenUpdating = True
   
1 End Sub

 

شكرا لاهتمامك استاذي الفاضل 

انا جربت الكود بتظهر رسالة خطأء وبيتم تحديد اخر سطر فى الكود  ( 1 End Sub )

كما واضح فى الصورة

 

Capture.PNG.ae714d2fde34c7a588ee4bc512c92654.PNG

رابط هذا التعليق
شارك
احمد بدره

احمد بدره

قام بنشر
قام بنشر

بعد إذن الأستاذ سليم

اكتب

Next

في سطر قبل End sub

ليصبح الكود

Sub Click3()

 Application.ScreenUpdating = False

On Error GoTo 1
    
    Dim ws As Worksheet: Set ws = Sheets("add")
    Dim N, C2 As Range
    Dim I%
      '   On Error Resume Next
For Each N In ws.Range("H6:H" & ws.Range("B" & Rows.Count).End(xlUp).Row)
 
  If N.Value = "محمود" Or N.Value = "احمد" Then
     For I = 111 To 256
      If I = 117 Or I = 164 Or I = 183 Then I = I + 1
      If I = 180 Then I = I + 2
       N.Offset(0, I) = vbNullString
   Next
   End If
   
      N.Offset(0, 165) = Format(Round(N.Offset(0, 180) + N.Offset(0, 181), 2))
 Application.ScreenUpdating = True
 Next
1  End Sub

  • Like 1
رابط هذا التعليق
شارك
سليم حاصبيا

سليم حاصبيا

قام بنشر
قام بنشر

الكود فقظ انا وضعته  و لم أجربه

لكن في رأي ان  Next يجب ان توضع بعد   End If  وليس  قبل End sub

حتى لا تتكرر عبارة   N.Offset(0, 165) = Format(Round(N.Offset(0, 180) + N.Offset(0, 181),  عند كل حلقة تكرارية

ليبدو الكود بهذا الشكل 

Option Explicit

Sub Click3()

 Application.ScreenUpdating = False

On Error GoTo 1
    
    Dim ws As Worksheet: Set ws = Sheets("add")
    Dim N, C2 As Range
    Dim I%
      '   On Error Resume Next
For Each N In ws.Range("H6:H" & ws.Range("B" & Rows.Count).End(xlUp).Row)
  
  If N.Value = "محمود" Or N.Value = "احمد" Then
     For I = 111 To 256
      If I = 117 Or I = 164 Or I = 183 Then I = I + 1
      If I = 180 Then I = I + 2
       N.Offset(0, I) = vbNullString
      End If
Next
      N.Offset(0, 165) = Format(Round(N.Offset(0, 180) + N.Offset(0, 181), 2))
1:
 Application.ScreenUpdating = True
   
 End Sub

 

  • Like 1
رابط هذا التعليق
شارك
ابو حمادة

ابو حمادة

قام بنشر
  • الكاتب
قام بنشر

شكر لكم اساتذتى الافاضل ولكن هناك عدة مشاكل الكود اشتغل لما اضفط ( Next ) قبل  End sub

ولكن تقيل جدا جدا فى التنفيذ والنتيجه خطأ 

وايضا هذا السطر بالكود الاول    

    N.Offset(0, 118) = Format(Round(N.Offset(0, 171) + N.Offset(0, 172) + N.Offset(0, 173) + N.Offset(0, 174), 2))

لم يدرج فى الكود هذا 

علما انا هذا السطر يجب تنفيذه قبل مسح باقي البيانات

فلذلك النتيجه خطأ

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

ولكم منى جزيل الشكر 

 

رابط هذا التعليق
شارك
shreif mohamed

shreif mohamed

قام بنشر
قام بنشر (معدل)

وعليكم السلام ورحمه الله  وبركاته

  

Sub Click3()
On Error GoTo 1
    
    Dim ws As Worksheet: Set ws = Sheets("add")
    Dim N, C2 As Range
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
      '   On Error Resume Next
For Each N In ws.Range("H6:H" & ws.Range("B" & Rows.Count).End(xlUp).Row)
    If N.Value = "محمود" Or N.Value = "احمد" Then
    Range(N.Offset(0, 111), N.Offset(0, 116)).ClearContents
'   N.Offset(0, 117) = ""
    N.Offset(0, 118) = Format(Round(N.Offset(0, 171) + N.Offset(0, 172) + N.Offset(0, 173) + N.Offset(0, 174), 2))
    Range(N.Offset(0, 119), N.Offset(0, 163)).ClearContents   
'   N.Offset(0, 164) = ""
    N.Offset(0, 165) = Format(Round(N.Offset(0, 180) + N.Offset(0, 181), 2))
    Range(N.Offset(0, 166), N.Offset(0, 169)).ClearContents
    Range(N.Offset(0, 175), N.Offset(0, 179)).ClearContents     
'   N.Offset(0, 180) = "" ''
'   N.Offset(0, 181) = "" ''
    N.Offset(0, 182).ClearContents
'   N.Offset(0, 183) = "" ''
    Range(N.Offset(0, 184), N.Offset(0, 256)).ClearContents
End If
Next
      Application.ScreenUpdating = True
      Application.Calculation = xlCalculationAutomatic
1 End Sub

 

تم تعديل بواسطه shreif mohamed
  • Thanks 1
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

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

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept