سليم حاصبيا

هذا ملف نموذج عما تريد Time_format.rar

ربما كان المطلوب هذه المرة تم حماية الورقة (يدون كلمة سر) للمحافظة على المعادلات الخلايا التي تدخل فيها البيانات غير محمية يجب كتابة وقت بدء الدوام بعد منتصف الليل اذا كان موجوداً ليتم حسابه انظر الى الورقة Final new Time working.rar

تستطيع ان تستعمل هذا المعادلة البسيطة في الملف (يلزم فقط تغيير عناوين الخلايا الى ما تحتاجه) RASEB,NAGEH.rar

شاهد هذا الفيديو

التعديل المطلوب Time working.rar

جرب هذا الملف ملاجطة:بجب ازالة دمج الخلايا كي تعمل المعادلة في المكان المخصص لها salim file.rar

تم التعديل على الملف conditional format Salim 1.rar

جرب هذا الماكرو Option Explicit Sub Create_TOC() Application.ScreenUpdating = False Dim wbBook As Workbook Dim wsActive As Worksheet Dim wsSheet As Worksheet Dim lnRow As Long Set wbBook = ActiveWorkbook With Application .DisplayAlerts = False .ScreenUpdating = False End With ''''''''''''''''''''''''''''''''''''''''''''''''''''''''' On Error Resume Next Sheets("الرئيسيه").Select ActiveSheet.Range("A2:A500").ClearContents On Error GoTo 0 Set wsActive = wbBook.ActiveSheet lnRow = 2 For Each wsSheet In wbBook.Worksheets If wsSheet.Name <> wsActive.Name Then With wsActive .Hyperlinks.Add .Cells(lnRow, 1), "", _ SubAddress:="'" & wsSheet.Name & "'!A1", _ TextToDisplay:=wsSheet.Name End With lnRow = lnRow + 1 End If Next wsSheet wsActive.Activate With Application .DisplayAlerts = True .ScreenUpdating = True End With With ActiveSheet.Range("a1:a500") With .Font .Size = 16 .Bold = True .Underline = False End With .EntireColumn.AutoFit .Range("a1").Select End With Application.ScreenUpdating = True End Sub

جرب هذا الماكرو Sub Talween() Lr = Sheets("sheet1").Cells(Rows.Count, 3).End(3).Row If Lr < 2 Then Lr = 2 Sheets("sheet1").Range("b2:b" & Lr).Interior.ColorIndex = 0 m = 2 For i = 2 To Lr If IsNumeric(Range("c" & i)) Then x = (Abs(Range("c" & i).Value) + 1) Mod 56 + 1 Range("b" & i).Interior.ColorIndex = x + m End If Next End Sub

جرب هذا الشيء conditional format Salim 1.rar

تم التعديل العمل الإضافي مارسsalim1.rar

استبدل الكود بهذا Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) Application.EnableEvents = False Application.DisplayAlerts = False If Target.Column <> 3 Or Target.Count > 1 Then Exit Sub lr = Sheets("Accounts").Range("c" & Rows.Count).End(xlUp).Rows.Value Sheets("Sample").Copy after:=Sheets(Sheets.Count) On Error Resume Next x = Len(Sheets(lr).Name) If IsEmpty(x) Then ActiveSheet.Name = lr ActiveSheet.Range("b2") = lr Else Answer = MsgBox("This sheet is allredy exit" & Chr(10) & "do you wnat to replace it?", vbYesNo) If Answer = 6 Then Sheets(lr).Delete ActiveSheet.Name = lr ActiveSheet.Range("b2") = lr Else ActiveSheet.Delete End If End If Application.EnableEvents = True Application.DisplayAlerts = True End Sub

لم ار اي خطأ في الملف قل لين الخطأ مثلا! في اي خلية

تم معالجة الامر اذا كان لديك اوقيس 2010 الملف الاول اما قبل 2010 الملف الثاني احصاء زبائن الفروع salim 2010.rar احصاء زبائن الفروع salim 2003.rar

رغم انك لم ترفع الملف المطلوب أتوقع ان يكون الحل هنا(نموذج عما تريد) ترقيم على كيفك.rar

الملف فيه كل التوضيحات العمل الإضافي مارسsalim.rar

بدل خلفية العامود الى الابيض

لتجاوز الاحطاء تم تعديل الكود Sub transfer_with_ٍSalim1() Dim Sht_Source, Sht_Target As Worksheet Dim lr1, lr2, My_Row, My_Column As Integer Dim My_Name As String, Oldsum Dim My_Error As Long Set Sht_Source = Sheets("المكافآة"): Set Sht_Target = Sheets("تجميع المكافآت على مدار العام") lr1 = Sht_Source.Cells(Rows.Count, 1).End(3).Row lr2 = Sht_Target.Cells(Rows.Count, 1).End(3).Row My_Column = Application.Match(Sht_Source.Range("d2"), Sht_Target.Range("c4:n4"), 0) + 2 For i = 5 To lr1 On Error Resume Next My_Name = Sht_Source.Range("b" & i).Value My_Row = Application.Match(My_Name, Sht_Target.Range("b5:b" & lr2), 0) + 4 '============================================== My_Error = Err.Number: If My_Error <> 0 Or My_Name = "" Then GoTo 1 Oldsum = Sht_Target.Cells(My_Row, My_Column) Sht_Target.Cells(My_Row, My_Column) = Oldsum + Sht_Source.Cells(i, 3) '============================================== 1: My_Error = 0 Next End Sub

ضع فاصلة عليا قبل الرقم فاصلة عليا Shift+ حرف الطاء (لغة الكيبورد اجنبية)

جرب هذا الملف لا يمكن الكتابة الا في الاعمدة M,I,F,A لأن الورقة محمية (بدون كلمة سر) لعدم العبث بالمعادلات عن طريق الخطأ البرنامح لا يعطي النتيجة المطلوبة لكل وردية الا عند كتابة تاريخ وقت ابتداء العمل وانتهائه في هذه الوردية يجب كتابة الوقت و التاريخ بهذا الشكل ( نموذج) كما في المرفق 10/3/2017 6:00:00 AM or 15/3/2017 6:00:00 PM اي بتنسيق mm/dd/yyyy hh:mm Working with Time.rar

هذه المعادلة تفي بالغرض =IF((B1-A1)/B1<=0.03,B1,"")

يمكن جمع المعادلتين في واحدة تكتب في الخلية B2 ,وتسحب يساراً ثم نزولاً =CHOOSE(COLUMNS($A$1:A1),IF(ISNUMBER($D2),$D2,""),IF(ISTEXT($D2),$D2,""))

في الخليةC2هذه المعادلة , واسحب نزولاً =IF(ISNUMBER(D2),D2,"") في الخليةB2هذه المعادلة , واسحب نزولاً =IF(ISTEXT(D2),D2,"")

الصق هذه المعادلة في الخلية H3 واسحب يساراً ثم الى الاسفل =SUMPRODUCT($D$3:$D$12,--(MONTH($C$3:$C$12)=COLUMNS($A$1:A1)+1),--($B$3:$B$12=$G3))

في هذه الحالة اليك هذا الماكرو Sub transfer_with_ٍSalim() Dim Sht_Source, Sht_Target As Worksheet Dim lr1, lr2, My_Row, My_Column As Integer Dim My_Name As String, Oldsum Set Sht_Source = Sheets("المكافآة"): Set Sht_Target = Sheets("تجميع المكافآت على مدار العام") lr1 = Sht_Source.Cells(Rows.Count, 1).End(3).Row lr2 = Sht_Target.Cells(Rows.Count, 1).End(3).Row My_Column = Application.Match(Sht_Source.Range("d2"), Sht_Target.Range("c4:n4"), 0) + 2 For i = 5 To lr1 My_Name = Sht_Source.Range("b" & i).Value My_Row = Application.Match(My_Name, Sht_Target.Range("b5:b" & lr2), 0) + 4 Oldsum = Sht_Target.Cells(My_Row, My_Column) If IsNumeric(Sht_Source.Cells(i, 3)) And IsNumeric(Oldsum) _ Then Sht_Target.Cells(My_Row, My_Column) = Oldsum + Sht_Source.Cells(i, 3) Next End Sub