سليم حاصبيا

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

=IF(OR($C5:$J5="غ");"دون المستوى";"ناجح") جرب هذه المعادلة في الخلية U5 اضفط Ctrl+Shift+Enter ثم اسحب نزولاً =IF(OR($C5:$J5="غ"),"دون المستوى","ناجح") اذا لم تعمل معك استبدل الفاصلة بفاصلة منقوطة لتصبح هكذا

جرب هذا الملف protect non empty data.rar

تم تعديل الماكرو (انظر الى الاقتياس الاول)و استبدل الماكرو بالجديد

جرب هذه المعادلة في الخلية C5و اسحب نزولاُ =CHOOSE(($C$4="Total")+1,INDEX(Sheet1!$B$4:$G$8,MATCH(Sheet1!$A4,Sheet1!$A$4:$A$8,0),MATCH(Sheet2!$C$4,Sheet1!$B$3:$G$3,0)),SUM(Sheet1!$B4:$G4))

تم التعديل على الماكرو بحيث لا يتعاطى مع القيم غير المكررة

جرب هذا الكود Sub talween() Dim t As Integer t = 4 Range("a3:b15").Interior.ColorIndex = xlNo For i = 1 To Range("a3:b15").Count For k = 1 To Range("a3:b15").Count If Application.CountIf(Range("a3:b15"), Range("a3:b15").Cells(i)) = 1 Then Range("a3:b15").Cells(i).Interior.ColorIndex = xlNo Exit For End If If Range("a3:b14").Cells(i) = Range("a3:b15").Cells(k) Then Range("a3:b15").Cells(k).Interior.ColorIndex = t End If Next t = t + 1 Next End Sub

اكتب هذه المعادلة في J5 ثم اسحب يميناً و الى اسفل =COUNTIFS($A$2:$A$24,$I5,$B$2:$B$24,J$4)

اذهب الى هذا العنوان https://www.officena.net/ib/topic/75257-ترتيب-الأسماء-وفق-تاريخ-الميلاد/#comment-482983

جرب الملف المرفق بيان بمعلمى المدرسة Salim.rar

نفس الكود لكن بطريقة مختصرة Sub Test1() Dim x As Long, bb As Byte, m As Integer Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents m = 0: bb = Range("D1").Value: numl = Range("F1").Value For x = 1 To numl: If x Mod bb = 0 Then x = x + 1 Cells(m + 1, 1) = x: m = m + 1: Next MsgBox "Done..... (-_-)" End Sub

تم معالجة الامر تم تغيير اسماء الصفحات لحسن العمل مع اللغة الاجنبية Report salim.rar

جرب هذا الماكرو (يوضع في حدث الصفحة Sheet1) Private Sub Worksheet_Activate() Range("A:A").ClearContents For i = 2 To Sheets.Count Range("A" & i + 2).Formula = "=" & "Sheet" & i & "!$B$2" Next End Sub

هل لاحظت ان 33*8+60 لا تساوي 513

الاجابة في هذا الملف Salim function_Vba.rar

جرب هذا الكود Sub Salim_Macro() Dim i As Integer Dim ws As Worksheet Set ws = Sheets("sheet1") ws.Range("a:a").ClearContents For i = 2 To Sheets.Count ws.Range("A" & i + 2) = Evaluate("Sheet" & i & "!B4") Next End Sub وهذا ماكرو ثاني (اسرع ) Sub Salim_Macro1() Dim arr() Dim ws As Worksheet Set ws = Sheets("sheet1") ws.Range("a:a").ClearContents ReDim arr(2 To Sheets.Count) For i = 2 To Sheets.Count arr(i) = Sheets(i).Range("b4") Next ws.Range("a4").Resize(Sheets.Count - 1, 1) = Application.Transpose(arr) Erase arr End Sub

بعد اذن المكتبة طبعاٌ تحسين بسيط على الكود لنحصل على نطاق اكبر Private Sub TextBox1_Change() On Error Resume Next If ActiveSheet.AutoFilterMode = True Then: ActiveSheet.ShowAllData If (Me.TextBox1.Value) = "" Then: ActiveSheet.AutoFilterMode = False: GoTo 1 Range("B6:K" & Cells(Rows.Count, "k").End(3).Row).AutoFilter Field:=1, Criteria1:="=*" & TextBox1.Text & "*", Operator:=xlAnd Exit Sub 1: End Sub

انت لم توضح المطلوب من بداية الامر قلت فقط في الخلايا B2 & B3 اليك المطلوب Book2 salim.rar

المعادلة الصحيحة =IF(A8="","",IF($B8="مهن",IF(10%*SUM(H8:W8)>=243,243,ROUND(10%*SUM(H8:W8)-1,IF($B8="ادارى",IF(10%*($G8+$I8-$D8)>=243,243,10%*($G8+$I8-$D8)),2))),""))

استبدل الكود بهذا Sub row_height() With ActiveSheet .Cells.RowHeight = 25 lr = .Cells(Rows.Count, 2).End(3).Row .Range("b1:b" & lr - 1).RowHeight = 14.5 End With End Sub

ارقع الملف للعمل عليه

اليك هذا الماكرو Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column <> 2 Then Exit Sub Target.Columns.AutoFit End Sub

جرب هذا الماكرو Sub row_height() Sheet1.Cells.RowHeight = 25 lr = Sheet1.Cells(Rows.Count, 1).End(3).Row Sheet1.Range("a1:a" & lr - 1).RowHeight = 14.5 End Sub ربما ليس هناك بيانات في العامود A جرب ان تكتب شيئاً في هذا العامود ولو اربعة او خمسة صفوف

الكود الذي ينسخ كل شيء Sub Get_names1() m = 0 For i = 2 To Sheets.Count t = Application.CountA(Sheets(i).Range("b:b")) - 1 Sheets(i).Range("b2:b" & t + 1).Copy Sheets("sheet1").Range("b" & m + 2) m = m + t Next End Sub

جرب هذا الماكرو Sub row_height() Sheet1.Cells.RowHeight = 25 lr = Sheet1.Cells(Rows.Count, 1).End(3).Row Sheet1.Range("a1:a" & lr - 1).RowHeight = 14.5 End Sub