الرائد77

تفضل

=IF(WEEKDAY(P2)=5;P2+2;P2+1)

Book1 (1).xlsx

تفضل ضع هذه المعادلة لاستخراج الارقام الى الخلية المجاورة  ثم اجمع

مثال.xlsx

تفضل

حركة المبيعات.xlsb

المصنف1.xlsb

=IF(COUNTA($B$5:$B$14)=ROW($A14)-4;"مكتمل";IF(COUNTA($B$5:$B$14)=0;"فارغ";IF(COUNTA($B$5:$B$14)<ROW($A14)-4;"غير مكتمل";"")))

تفضل

بحث-خلايا.xlsx

تفضل مع ان ملفك يفتقد الى البيانات

Private Sub ListBox1_Click()
TEXT1.Value = ListBox1.ListIndex + 2
SpinButton1.Value = ListBox1.ListIndex
End Sub

Private Sub SpinButton1_Change()

    If SpinButton1.Value = 0 Then SpinButton1.Value = ListBox1.ListCount - ListBox1.ListCount + 1
    
    ListBox1.ListIndex = ListBox1.ListCount - SpinButton1.Value
   TEXT1.Value = ListBox1.ListIndex + 2
    

End Sub
 

Private Sub UserForm_Initialize()
 
    
    SpinButton1.Max = ListBox1.ListCount
    SpinButton1.Min = 0
    
    SpinButton1.Value = 10
    
End Sub

TEST.xlsm

تفضل

Sub NTAx()
Dim lr As Integer
lr = ActiveSheet.Cells(Rows.Count, 13).End(xlUp).Row
For i = 2 To lr

Select Case Cells(i, 13).Value
Case Is > 83333.33

Cells(i, 14).Value = 7500 + (Cells(i, 3).Value - 33333.33) * 25 / 100
Case Is > 75000
Cells(i, 14).Value = 3333.33 + 3750 + (Cells(i, 13) - 33333.33) * 25 / 100

Case Is > 75000
Cells(i, 14).Value = 3333.33 + 3750 + (Cells(i, 13) - 33333.33) * 25 / 100
Case Is > 66666.67
Cells(i, 14).Value = 750 + 2333.33 + 3750 + (Cells(i, 13) - 33333.33) * 25 / 100
Case Is > 58333.33
Cells(i, 14).Value = 375 + 187.5 + 2333.33 + 3750 + 7291.67 + (Cells(i, 13) - 33333.33) * 25 / 100
Case Is > 50000
Cells(i, 14).Value = 62.5 + 125 + 187.5 + 2333.33 + 3750 + (Cells(i, 13) - 33333.33) * 25 / 100
Case Is > 41666.67
Cells(i, 14).Value = 31.25 + 125 + 187.5 + 2333.33 + 3750 + (Cells(i, 13) - 33333.33) * 25 / 100
Case Is > 33333.33
Cells(i, 14).Value = 31.25 + 125 + 187.5 + 2333.33 + 3750 + (Cells(i, 13) - 33333.33) * 25 / 100
Case Is > 16666.67
Cells(i, 14).Value = 3750 + 2333.33 + 187.5 + 125 + 31.5 + (Cells(i, 13) - 16666.67) * 25 / 100

Case Is > 5000
Cells(i, 14).Value = 2333.33 + 187.5 + 125 + 31.25 + (Cells(i, 13) - 5000) * 22.5 / 100

Case Is > 3750
Cells(i, 14).Value = 187.5 + 125 + 31.25 + (Cells(i, 13) - 3750) * 20 / 100

Case Is > 2500
Cells(i, 14).Value = 125 + 31.25 + (Cells(i, 13) - 2500) * 15 / 100
Case Is > 1250
Cells(i, 14).Value = 31.25 + (Cells(i, 13) - 1250) * 10 / 100
Case Is < 1250
Cells(i, 14).Value = Cells(i, 13) * 2.5 / 100

End Select
Next


End Sub

معادلة الضرائب الجديده.xlsm

تفضل

النبطشيه.xlsx

السلام عليكم

لا أنصحك باستعمال هده الطريقة. الملف غير وظيفي33 صفحة؟؟؟؟؟ . لمادا كل شيت عمل بتقرير؟؟؟

أنت تحتاج شيت لتقرير واحد و ترحل اليه البيانات حسب التاريخ 

انت تحتاج فقط الى 5 اوراق عمل . 

1-ورقة لغيابات الاساتدة

2-ورقة لغيابات  التلاميذ

3-ورقة للملاحظات بما فيها االزيارات 

4-ورقة  لغياباب موظفي الاستشارة

و الورق 5 للتقرير 

تسجل غيابات الموظفين حسب كل فئة في ورقته. ثم ترحل البيانات الى التقرير حسب التارييخ عن طرريق الماكرو أو المعادلات

تفضل

BOOK--Excel.xlsm

يمكنك عمل ذللك بـ: nested if و لكن عند اضافة الشيتات تضظر دائما اللى تغييير المعادلات باضافة الاوراق  الجديدة

كما أانه في حال بيانات كثييرة تكون الاستتجابة بظيئة.

تفضل هدا  الكود اسرع و يعمل مهما اضفت من صفحات جديدة.

ضع فقط الارقام التي تريد في العمود A في ششيت البحث ثم اضغط جلب.

Sub bring()
Dim ash As Worksheet
Dim sh As Worksheet
Dim cell As Range
Dim lrw As Integer
Set ash = Sheets("search")

ash.Range("b2:e1000").ClearContents
For Each sh In ThisWorkbook.Sheets
If sh.Name <> ash.Name Then
For Each cell In sh.Range("a2:a1000")
lrw = ash.Cells(Rows.Count, 1).End(xlUp).Row
For i = 2 To lrw
If cell = ash.Cells(i, 1) Then
ash.Cells(i, 2) = cell.Offset(, 1)
ash.Cells(i, 3) = cell.Offset(, 2)
ash.Cells(i, 4) = cell.Offset(, 3)
ash.Cells(i, 5) = cell.Offset(, 4)
End If
Next i
Next cell
End If
Next sh



End Sub

جلب بيانات من الشيتات.xlsb

بالننسبة لاستثناء اوراق معينة ييمكنك االتغيير فيي كود listbox click الى هدا الكود

Private Sub ListBox1_Click()
If ListBox1.ListIndex > -1 Then
     Sheets(ListBox1.Value).Activate
     
    
    If Sheets(ListBox1.Value).Name <> "ورقة1" And Sheets(ListBox1.Value).Name <> "وررقة2" And Sheets(ListBox1.Value).Name <> "ورقة3" Then
     Sheets(ListBox1.Value).Range("d5") = Sheets("ورقة1").Range("f1")
     Sheets(ListBox1.Value).Range("d5").Select
     End If
  End If
End Sub

نموذج الملف (1) (1).xls

تم التصحيح .الكود يعمل 

الخطأ في الخلايا المدمجة.

قاعدة.xlsm

تفضل

نموذج الملف (1).xls

تفضل

Private Sub ListBox1_Click()
If ListBox1.ListIndex > -1 Then
     Sheets(ListBox1.Value).Activate
     
    
    If Sheets(ListBox1.Value).Name <> "ورقة2" And Sheets(ListBox1.Value).Name <> "ورقة3" Then
     Sheets(ListBox1.Value).Range("d5") = Sheets("ورقة1").Range("f1")
     End If
  End If
End Sub

نموذج الملف.xls

تتفضل. الكود يعمل 100/100 بعد التعديل. تم التجربة

Sub Button3_Click()
  Dim OutApp    As Object
  Dim OutMail   As Object
For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row


  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)
  With OutMail
    .To = Range("A" & i).Value
    .CC = Range("B" & i).Value
    .Subject = Range("C" & i).Value
    .HTMLBody = Range("D" & i).Value
    .Send
  End With
  On Error GoTo 0
  Set OutMail = Nothing
  Set OutApp = Nothing
  MsgBox Range("A" & i).Value
  Next i
End Sub

إيميللات (1).xlsm

تفضل االمطلوب

عند تكرار الاسم في الخيارين الاول و الثاني لن تظهر النتيجة

تعبئه تلقائيه.xlsm

غير الى هذا الكود

  Dim OutApp    As Object
  Dim OutMail   As Object


  Set OutApp = CreateObject("Outlook.Application")
  Set OutMail = OutApp.CreateItem(0)
For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
  With OutMail
    .To = Range("A" & i).Value
    .CC = Range("B" & i).Value
    .Subject = Range("C" & i).Value
    .HTMLBody = Range("D" & i).Value
    .Send
  End With
  On Error GoTo 0
  Set OutMail = Nothing
  Set OutApp = Nothing
  MsgBox Range("A" & i).Value
  Next i

إيميللات.xlsm

غير فقط  activesheet الى نطاق الصفحة الاولى

ActiveSheet.ExportAsFixedFormat xlTypePDF, mypath & "\" & Range("a11").Value & ".pdf", xlQualityStandard

لتصبح

ActiveSheet.Range("A1:i33").ExportAsFixedFormat xlTypePDF, mypath & "\" & Range("a11").Value & ".pdf", xlQualityStandard

تفضل  بالمعادلات.  و الاعمدة المساعدة

. لا تقم بايي تتغيير على المعادلات خاصة على العمود H

احصائيات حسب السن و الجنس. 

قوائم حسب السن و الجنس. لاحظ الصور

قوائم السن.xlsx

غير الى عربية لبلد آخر . و اعد تشغيل الجهاز .   

عند تصدير الملف . فتحته بالاوتلوك . تظهر عادي غير مشفرة

تفضل

التكت.xlsm

الملف يعمل عادي.قمت بتجريب ملفك بدون تغيير . الاسماء تصدر بالعربية عادي.

المشكل عندك في اعداادات اللغة. ادهب الى لوحة التحكم و اعدادات اللغة .كما في الصوورة

و أعد تشغيل الجهاز

بارك الله فيك أستاذة.زادك الله من فضله و بارك في علمك