اذهب الي المحتوي
أوفيسنا

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

قام بنشر

أستاذي العزيز أشكرك جزيل الشكر على المساعدة

 

لكن الكود بطيئ جدا بعكس الكود الأول الخاص بالجمع بين تاريخين

 

 

أستاذي أريد أن أشألك سؤال فيما يخص موصوعك تحويل الدوال إلى كود  عندما جربته في الدالة الخاصة بالجمع بين تاريخين أتى بكود لكن لم ينجح فهل الكود الذي يجلبه  يجب أن تضيف عليه تعديلات أم إستعمال مباشر

قام بنشر

لم أتاكد من عمل الكود مسبقاً

بعد التجربه فعلا بطيء

 

جرب التعديل التالي

 

Public Sub Ali_Vlc()
Dim Sh As Worksheet
Dim Rm As Range, Rn As Range
Set Sh = Worksheets("raball")
With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
Set Rm = Lr(Sh, 1, 0)
Rx Sh, Rm, 46, 35: Rx Sh, Rm, 47, 8: Rx Sh, Rm, 48, 38
  .ScreenUpdating = True
  .Calculation = xlCalculationAutomatic
End With
End Sub
Sub Rx(Sh As Worksheet, Rn As Range, Co As Variant, V As Integer)
Dim R As Range
Dim xl
With Sh
For Each R In Rn
xl = Application.VLookup(Val®, [bd], V, False)
 Select Case .Cells(R.Row, Co)
     Case Is = "": .Cells(R.Row, Co) = ""
     Case IsError(xl): .Cells(R.Row, Co) = ""
 End Select
 If Not IsError(xl) Then .Cells(R.Row, Co) = xl
Next
End With
End Sub
Private Function Lr(ByVal Sh As Worksheet, ByVal Col As Variant, Optional ByVal Fst As Long) As Range
  With Sh
    Set Lr = .Range(.Cells(6, Col), .Cells(.Rows.Count, Col).End(xlUp).Offset(Fst))
  End With
End Function
قام بنشر (معدل)

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

 

 

يعمل بشكل رائع وسريع جزاك الله كل خير  وجعله الله في ميزان حسناتك

--------------------------------------------------------

عندما أردت تجريبه في الورقة hhh نقلت الكود وغيرت في الجزئية إسم الورقة 

 

فهل أقوم يتغيير إسم الورقة فقط لكي ينجح  

 

 

الشرح في الصورة المرفقة

 

 

صصص.rar

تم تعديل بواسطه ريان أحمد

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

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

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

Important Information