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

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

قام بنشر

الأخ الفاضل

سبق أن طلبت منك تغيير اسم الظهور للغة العربية لسهولة التواصل

الحل المقدم من الأخ الغالي خزاني حل بسيط وجميل جداً

أنا فقط ترجمته إلى الكود

Sub TimeCalculate()
    With Range("C2:C" & Cells(Rows.Count, 1).End(xlUp).Row)
        .Formula = "=MOD(B2-A2,1)"
        .Value = .Value
    End With
End Sub

تقبل تحياتي

  • Like 1
قام بنشر

السؤال هو .. طالما أنك تريد أن يتم تنفيذ الكود بشكل تلقائي ..

هل تريد ان يتم العمل بمجرد التغير في أي خلية في العمود الأول أو الثاني

وهل التغير يصحبه التعامل مع الكود صف واحد فقط في كل مرة أم أنك تريد تنفيذ الكود على كامل العمود الثالث ؟؟

قام بنشر

جزيت خيرا كود حلو بس لو تشرح الكود مااقدرت اطبقة في اعمدة خرى 

 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.CountLarge > 1 Then Exit Sub
    If Target.Row > 1 And Target.Column = 2 Then
        With Target.Offset(, 1)
            .Formula = "=MOD(" & (Target - Target.Offset(, -1)) & ",1)": .Value = .Value
        End With
    End If
End Sub
قام بنشر

تفضل أخي الحبيب

Private Sub Worksheet_Change(ByVal Target As Range)
'إذا كان عدد الخلايا التي سيتم التعامل معها أكبر من واحد يتم الخروج من الإجراء الفرعي
    If Target.Cells.CountLarge > 1 Then Exit Sub
'إذا كانت الخلية الهدف التي سيتم تعديلها في أي صف أكبر من الصف رقم 1
'كما أنها في العمود الثاني يتم تنفيذ التالي
    If Target.Row > 1 And Target.Column = 2 Then
'الخلية المجاورة للخلية الهدف
        With Target.Offset(, 1)
'يتم وضع المعادلة التي تحقق المطلوب والحصول على القيمة فقط
            .Formula = "=MOD(" & (Target - Target.Offset(, -1)) & ",1)": .Value = .Value
        End With
    End If
End Sub

تقبل تحياتي

  • Like 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.

×
×
  • اضف...

Important Information