زيادة الوقت

[علي بطيخ سالم]

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

ازاي اعمل التوقيت من وإلى حسب تسلسل الأرقام الموجودة في العمود E بمعلومية بداية التوقيت والزيادة بالدقائق ليكون الناتج كما هو مبين في العمودين سي ودي ... انا هضع فقط توقيت البداية والزيادة بالدقائق فقط والتوزيع يكون تلقائي بارك الله فيكم

توقيت البداية.xlsx

[AbuuAhmed]

حسب ما فهمته:

توقيت البداية_02.xlsx

[محمد هشام.]

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

لم توضح أخي @علي بطيخ سالم  هل الزيادة ستنفد على العمودين معا  او  الى فقط  

اليك محاولة مني بالاكواد لتثبيث الزيادة في عمود ( من) بساعة  دائما  وزيادة مدة الدقائق المدخلة في عمود (الى) 

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim crWS As Worksheet: Set crWS = Me
    Dim tmp As Date, n As Double, lastRow As Long, i As Long
    If Not Intersect(Target, crWS.Range("A2,B2")) Is Nothing Then
        
        If crWS.Range("A2").Value = "" Or Application.WorksheetFunction.IsText(crWS.Range("A2").Value) Then _
        MsgBox "يرجى إدخال توقيت البداية", vbExclamation: Exit Sub
        
        If Not IsNumeric(crWS.Range("B2").Value) Or _
        crWS.Range("B2").Value <= 0 Then: MsgBox "يرجى إدخال مدة الزيادة بالدقائق", vbExclamation: Exit Sub

        tmp = crWS.Range("A2").Value
        n = crWS.Range("B2").Value / 1440
        lastRow = crWS.Cells(crWS.Rows.Count, "E").End(xlUp).Row
        If lastRow < 2 Then Exit Sub

        Application.ScreenUpdating = False
        crWS.Range("C2:D" & crWS.Cells(crWS.Rows.Count, "C").End(xlUp).Row).ClearContents
        
        For i = 2 To lastRow
            If crWS.Cells(i, "E").Value <> "" Then
                crWS.Cells(i, "C").Value = Format(tmp, "hh:mm")
                crWS.Cells(i, "D").Value = Format(tmp + n, "hh:mm")
               tmp = tmp + TimeSerial(1, 0, 0)
             ' لتنفيد الزيادة بالدقائق على العمودين من و الى
               '  tmp = tmp + n

            End If
        Next i

        Application.ScreenUpdating = True
    End If
End Sub

في حالة الرغبة بتنفيد الزيادة على العمودين

tmp = tmp + n

 

 

توقيت البداية.xlsb

تم تعديل منذ 23 ساعات بواسطه محمد هشام.

[علي بطيخ سالم]

7 ساعات مضت, AbuuAhmed said:

حسب ما فهمته:

توقيت البداية_02.xlsx 11.46 kB · 5 downloads

جميل استاذنا ابو احمد جزاكم الله خيراً ... لكن اريد ايضاَ أن ينفذ التغيير للعمودين بالفعل كما قام بعمله الاستاذ محمد هشام بالكود جزاكم الله خيراً وبارك الله لك على هذه المساهمة 

 

4 ساعات مضت, محمد هشام. said:

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

لم توضح أخي @علي بطيخ سالم  هل الزيادة ستنفد على العمودين معا  او  الى فقط  

اليك محاولة مني بالاكواد لتثبيث الزيادة في عمود ( من) بساعة  دائما  وزيادة مدة الدقائق المدخلة في عمود (الى) 

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim crWS As Worksheet: Set crWS = Me
    Dim tmp As Date, n As Double, lastRow As Long, i As Long
    If Not Intersect(Target, crWS.Range("A2,B2")) Is Nothing Then
        
        If crWS.Range("A2").Value = "" Or Application.WorksheetFunction.IsText(crWS.Range("A2").Value) Then _
        MsgBox "يرجى إدخال توقيت البداية", vbExclamation: Exit Sub
        
        If Not IsNumeric(crWS.Range("B2").Value) Or _
        crWS.Range("B2").Value <= 0 Then: MsgBox "يرجى إدخال مدة الزيادة بالدقائق", vbExclamation: Exit Sub

        tmp = crWS.Range("A2").Value
        n = crWS.Range("B2").Value / 1440
        lastRow = crWS.Cells(crWS.Rows.Count, "E").End(xlUp).Row
        If lastRow < 2 Then Exit Sub

        Application.ScreenUpdating = False
        crWS.Range("C2:D" & crWS.Cells(crWS.Rows.Count, "C").End(xlUp).Row).ClearContents
        
        For i = 2 To lastRow
            If crWS.Cells(i, "E").Value <> "" Then
                crWS.Cells(i, "C").Value = Format(tmp, "hh:mm")
                crWS.Cells(i, "D").Value = Format(tmp + n, "hh:mm")
               tmp = tmp + TimeSerial(1, 0, 0)
             ' لتنفيد الزيادة بالدقائق على العمودين من و الى
               '  tmp = tmp + n

            End If
        Next i

        Application.ScreenUpdating = True
    End If
End Sub

في حالة الرغبة بتنفيد الزيادة على العمودين

tmp = tmp + n

 

 

توقيت البداية.xlsb 22.03 kB · 2 downloads

جزاكم الله خيراً وبارك الله لك استاذنا هذا هو بالفعل المطلوب الله يرضى عنك وعن والديك والمسلمين

 

[AbuuAhmed]

موضوعك بسيط لا يحتاج إلى أكواد لكنه لم يكن واضح لي بشكل كامل وخصوصا باستخدامك مسلسل من 1 إلى 9 والتي توقعتها مضاعافات الساعة.

توقيت البداية_03.xlsx

[علي بطيخ سالم]

10 ساعات مضت, AbuuAhmed said:

موضوعك بسيط لا يحتاج إلى أكواد لكنه لم يكن واضح لي بشكل كامل وخصوصا باستخدامك مسلسل من 1 إلى 9 والتي توقعتها مضاعافات الساعة.

توقيت البداية_03.xlsx 9.85 kB · 6 downloads

بالفعل انا اخدت المعادلات اللي حضرتك قمت بعملها في المشاركة الأولى وقمت بالتعديل عليها جزاكم الله خيراً وبارك الله لك استاذنا وجعله الله في ميزان حسناتكم اللهم آمين