سليم حاصبيا

جرب هذا الملف ليس بحاجة الى وضع اي كود في جدث الصفحة Sub copy_data() With Sheets("sheet2") lr2 = .Cells(Rows.Count, 2).End(3).Row: If lr2 < 8 Then lr2 = 8 lr1 = Sheets("sheet1").Cells(Rows.Count, 2).End(3).Row: If lr1 < 8 Then lr1 = 8 Sheets("sheet1").Range("b8:o" & lr1).ClearContents .Range("b8:o" & lr2).Copy Sheets("sheet1").Range("b8") End With End Sub تعديل كود Salim.rar

جرب هذا الملف test Salim.rar

ربما يكون المطلوب ترحيل بشرط اختيار الصنف salim.rar

جرب هذا الملف معادلة salim.rar

ربما كان هذا المطلوب انظر الى الصفحة Salim v lookup SALIM2.rar

انظر الى الخلية I9 v lookup SALIM1.rar

ارفع نموذجاً عما تريد

جرب هذا الملف v lookup SALIM.rar

استغمل هذه المعادلة =VLOOKUP($T5,{0,"متعثر";0.2,"متأخر";0.5,"منتظم";1,"انتهى"},2)

المشكلة انك قمت بتسمية النطاق باسم احد اعمدة الاكسل (يوجد عامود بهذا الاسم nn)

تم معالجة الامر offset salim.rar

في هذا الملف البيانات في صفحة اخرى اخي ياسر ليس من الضرورة لهكذا معادلة طويلة (نسيت ان اضرب النتيجة بقيمة الخلية b&12 $ ) لتصبح هكذا =INDEX($A4:$I4,2*(COLUMNS($A$1:A1)-1)+3)*(1+$B$12) النسخ salim.rar

=INDEX($A4:$I4,MATCH(B$13,$B$2:$I$2,0)+2)*$B$12 بعد اذن اخي زيزو هذه المعادلة (انسخها الى الخلية B14) و اسحب يساراً ثم نزولاً =INDEX($A4:$I4,2*(COLUMNS($A$1:A1)-1)+3)*$B$12 اذا لم تعمل معك استبدل الفاصلة "," بفاصلة منقوطة";" أو هذه

ارفع نموذجاً عما تريد 30 <<<10 سطر

املأ نموذجاً عما تتوقعه

جرب هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) Application.ScreenUpdating = False Application.EnableEvents = False If Target.Column = 6 And Target.Row >= 6 And Target.Count = 1 Then lrf = Sheets("filter").Cells(Rows.Count, "f").End(3).Row: If lrf < 6 Then lrf = 6 Set my_rg = Range("f6:f" & lrf) lrb = Sheets("Data").Cells(Rows.Count, "B").End(3).Row: If lrb < 6 Then lrb = 6 For Each cel In my_rg If cel.Value = Date Then r = cel.Row Sheets("filter").Range("a" & r).Resize(1, 7).Copy Sheets("Data").Range("b" & lrb) lrb = lrb + 1 End If Next End If Application.ScreenUpdating = True Application.EnableEvents = True End Sub

الدالة المطلوبة: =IF($A5="","",IF(B5=$D$1,HLOOKUP($A5,$F$1:$I$2,2,0)+COUNTIF($B$5:B5,$D$1)-1,""))

انسخ عذع المغادلة الى الخلية F2 و اسحب نزولاً =IF(COUNT($B2:$D2)<3,"غائب",SUM($B2:$D2))

ربما يكون هذا الكود (المرفق)اسرع قليلاً SERCH_ARRY salim.rar

الملف مقفل بكلمة سر

(##.#0);(-##.#0);"("0")";@ يمكنك استعمال هذا التنسيق للارقام او هذا الكود يعمل في العامود الاول فقط(يمكن تعديله الى اي عامود تريد) Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 1 Or Target.Count > 1 Or Not IsNumeric(Target) Then GoTo 1 Application.EnableEvents = False Target.Value = Chr(13) & "(" & Target.Value & ")" 1: Application.EnableEvents = True End Sub

جرب هذا الماكرو Sub Salim() Dim Mg As Range Set Mg = Range("p1:p4") With Range("B6:N22") .HorizontalAlignment = xlGeneral .Font.Size = 16 End With For i = 6 To 22 With Range("b" & i) For j = 1 To 4 If .Value = Mg.Cells(j) Then .Font.Size = 24 .Resize(1, 13).HorizontalAlignment = xlCenterAcrossSelection End If Next End With Next End Sub لك ما تريد تم التعديل قليلاً على الماكرو ليعمل بشكل اسرع للبيانات الكثيرة Sub Salim1() Dim lr As Integer Application.ScreenUpdating = False If ActiveSheet.Name <> "ورقة1" Then Exit Sub lr = Cells(Rows.Count, 2).End(3).Row With Range("B6:N" & lr) .HorizontalAlignment = xlGeneral .Font.Size = 16 End With For i = 6 To lr With Range("b" & i) On Error Resume Next t = Application.WorksheetFunction.Match(Range("b" & i), Range("p1:p4"), 0) If t Then .Font.Size = 24: .Resize(1, 13).HorizontalAlignment = xlCenterAcrossSelection End With t = 0 On Error GoTo 0 Next Application.ScreenUpdating = True End Sub

جرب هذا الماكرو Sub Salim() Dim Mg As Range Set Mg = Range("p1:p4") With Range("B6:N22") .HorizontalAlignment = xlGeneral .Font.Size = 16 End With For i = 6 To 22 With Range("b" & i) For j = 1 To 4 If .Value = Mg.Cells(j) Then .Font.Size = 24 .Resize(1, 13).HorizontalAlignment = xlCenterAcrossSelection End If Next End With Next End Sub

ربما كان المطلوب Book1 salim.rar

جرب هذا الملف Newfolder1.rar