اعلن هنا
أكاديمية الصقر للتدريب
أعلن هنا
أعلن هنا
أعلن هنا
أعلن هنا



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


الرئيسية
نتائج البحث


نتائج البحث عن ردود العضو :زيزو العجوز
عدد النتائج (29) نتيجة
11-02-2018 06:32 مساء
icon مساعدة لموضوع الطلبة الاوائل | الكاتب :زيزو العجوز |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله 
عذرا اخى الكريم لانقطاع النت لدى
تم عمل اللازم ولكن بالكود
انسخ الكود التالى والصقه فى موديول وخصص له زر
وسيتم الترتيب بمجرد الضغط على الزر
المهم ان تكون الدرجات مرتبة تنازليا
Sub SelectRank()
Dim Mk As Variant

Dim i As Integer, j As Integer, x As Integer

For i = 5 To Range("F" & Rows.Count).End(xlUp).Row
If Cells(i, "F") <> "" Then
j = WorksheetFunction.CountIf(Range(Cells(5, 5), Cells(i, "F")), Cells(i, "F"))
If j = 1 Then
x = x + 1
If x < 1 Or x > 10 Then Exit Sub
Mk = Choose(x, "الاول", "الثانى", "الثالث", "الرابع", "الخامس", _
"السادس", "السابع", "الثامن", "التاسع", "العاشر")

Cells(i, 7) = Mk
Else
Cells(i, 7) = Mk & " " & "مكرر"
End If

End If
Next
End Sub
09-02-2018 02:49 مساء
icon مساعدة لموضوع الطلبة الاوائل | الكاتب :زيزو العجوز |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
تفضل اخى الكريم

 
07-02-2018 01:34 مساء
icon مساعدة لموضوع الطلبة الاوائل | الكاتب :زيزو العجوز |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
عفوا اخى الكريم تم اصلاح الجدول الاول فقط نظرا لكثرة المعادلات
عليك انت بالباقى
اليك الملف

 
06-02-2018 09:32 مساء
icon مساعدة لموضوع الطلبة الاوائل | الكاتب :زيزو العجوز |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
ما دمت تعمل على اوفيس 2003
للتحايل على هذا الاصدار استخدم الدالتين (IF + ISERROR) معا
و سيتم الحل ان شاء الله
05-02-2018 02:40 مساء
icon استدعاء الطلبة حسب سنة الميلاد لكل مستويات | الكاتب :زيزو العجوز |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
استخدم هذا الكود
Sub BirtDate()
Dim ws As Worksheet, Sht As Worksheet
Dim Dat As Date
Dim ShNam As String
Dim i As Long, j As Long, p As Long
Dim Arr As Variant, Temp As Variant
Set ws = Sheets("ورقة البحث")
ws.Range("A3:H" & ws.Range("C" & Rows.Count).End(xlUp).Row + 2).Clear
ShNam = ws.Range("G2").Value
Dat = ws.Range("H2").Value
Set Sht = Sheets(ShNam)
Arr = Sht.Range("B2:I" & Sht.Range("D" & Rows.Count).End(xlUp).Row).Value
ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Year(Arr(i, 4)) = Dat Then
p = p + 1
For j = 1 To 6
Temp(p, j) = Arr(i, Choose(j, 1, 2, 3, 4, 5, 7))

Next
End If
Next
If p > 0 Then ws.Range("A3").Resize(p, UBound(Temp, 2)).Value = Temp
ws.Range("A3:H" & p + 2).Borders.LineStyle = 1
End Sub


24-01-2018 09:17 مساء
icon التاريخ التلقائي للصف | الكاتب :زيزو العجوز |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
اكتب هذا الكود فى حدث الورقة
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 3 Then
Target.Offset(-1, 0) = Date
End If
End Sub

19-01-2018 10:56 مساء
icon كود لاستخدام المصفوفات لإخفاء الأعمدة التى قيمتها صفر | الكاتب :زيزو العجوز |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
بدون مصفوفات جرب هذا الكود
Sub DelCols()
Dim Rng As Range, Rw As Long, i As Long
Application.ScreenUpdating = False
Set Rng = ActiveSheet.Range("A2:CP" & ActiveSheet.Range("B" & Rows.Count).End(xlUp).Row)
Rw = Rng.Columns.Count
For i = Rw To 1 Step -1
If WorksheetFunction.Sum(Rng.Columns(i)) = 0 Then Rng.Columns(i).Hidden = True
Next
Application.ScreenUpdating = True
End Sub

15-01-2018 09:39 مساء
icon مشكلة في كود القائمة المنسدلة | الكاتب :زيزو العجوز |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
بالفعل هى تظهر فى Sheet2 فى ذات النطاق بدون ادنى مشاكل
15-01-2018 06:48 مساء
icon مشكلة في كود القائمة المنسدلة | الكاتب :زيزو العجوز |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
فى الكود Test حول Sheet2 الى Sheet3
هذا وبالله التوفيق
14-01-2018 01:53 مساء
icon حل مشكلة ظهور التاريخ ارقام في قائمة منسدلة في اليوزفورم | الكاتب :زيزو العجوز |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
الكود يوضع فى حدث الفورم
13-01-2018 08:32 مساء
icon كشوف اللجان للمحترم زيزو | الكاتب :زيزو العجوز |المنتدى: اكسيل اسئله واجابات
 شرح الاكواد بناءا على طلب الاستاذ محمد
شرح الكود الاول :
Sub AddLists()
   ' رقم ثابت يمثل طول كل لجنة
Const S = 48
Dim Mn As Worksheet
Dim Dist As Worksheet
Dim List As Worksheet
Dim Arr As Variant
Dim Temp As Variant
Dim x As Integer, y As Integer, z As Integer
Dim LR As Long, n As Long, i As Long, j As Long, p As Long

Application.ScreenUpdating = False
Set Mn = Sheets("بيانات الطلبة")
Set List = Sheets("كشوف اللجان")
     ' ارقام اول لجنتين
List.Range("D4") = 1
List.Range("K4") = 2
On Error Resume Next
    ' ازالة اى لجان قديمة
List.Range("B50:N" & List.Range("D" & Rows.Count).End(xlUp).Row + 49).Clear
   ' الزالة بيانات اول لجنتين فى حالة امتلاؤهما ببيانات سابقة
List.Range("B9:N47").ClearContents
   ' قيمة اكبر لجنة
x = WorksheetFunction.Max(Mn.Range("R7:R" & Mn.Range("E" & Rows.Count).End(xlUp).Row))
    '   اختبارعدد اللجان فردية ام زوجية يطرح منها 1 فى حالة فردية
    '   ويطرح منها 2 فى حالة زوجية
If x Mod 2 = 1 Then
y = Int(x / 2) - 1
Else
y = Int(x / 2) - 2
End If
    ' تحديد آخر صف لآخر لجنة
z = y * S + 50
   ' شرط عدد اللجان اكثر من 2
If y > 1 Then
   '  نسخ اول لجنتين
List.Range("B2:N49").Copy
  '  تحديد بداية ونهاية لصق كل لجنة
For n = 50 To z Step 48
List.Range("B" & n).PasteSpecial xlPasteAll
    ' كتابة ارقام الجلوس للجان التاية بقيمة متزايدة 2 فى كل جهة
List.Range("D" & n + 2) = List.Range("D" & n - 46) + 2
List.Range("K" & n + 2) = List.Range("K" & n - 46) + 2

Next
End If
List.Range("B9").Select
Application.CutCopyMode = False


Application.ScreenUpdating = True

End Sub



شرح الكود الثانى :
Sub FillLists()
Dim Mn As Worksheet
Dim Dist As Worksheet
Dim List As Worksheet
Dim LR As Long, n As Long, i As Long, p As Long, q As Long
Dim x, y, z
Dim xx, yy, zz
Application.ScreenUpdating = False
Set Mn = Sheets("بيانات الطلبة")
Set List = Sheets("كشوف اللجان")
LR = Mn.Range("E" & Rows.Count).End(xlUp).Row
    ' تحديد بدايات ونهايات اللجان كل نجنة على حدة
For n = 4 To List.Range("D" & Rows.Count).End(xlUp).Row Step 48
    ' نطاق مصدر البيانات
For i = 7 To LR
    ' شرط اللجنة اليمنى
If Mn.Cells(i, "R") = List.Cells(n, "D") Then
p = p + 1
     ' نقل البيانات
List.Cells(p + n + 4, "C") = Mn.Cells(i, "B")
List.Cells(p + n + 4, "D") = Mn.Cells(i, "E")
List.Cells(p + n + 4, "E") = Mn.Cells(i, "O")
List.Cells(p + n + 4, "F") = Mn.Cells(i, "P")
List.Cells(p + n + 4, "B") = p

End If
Next
p = 0
For i = 7 To LR
    ' شرط اللجنة اليسرى
If Mn.Cells(i, "R") = List.Cells(n, "K") Then
q = q + 1
     ' نقل البيانات
List.Cells(q + n + 4, "I") = q
List.Cells(q + n + 4, "J") = Mn.Cells(i, "B")
List.Cells(q + n + 4, "K") = Mn.Cells(i, "E")
List.Cells(q + n + 4, "L") = Mn.Cells(i, "O")
List.Cells(q + n + 4, "M") = Mn.Cells(i, "P")

End If
Next
q = 0
Next
Application.ScreenUpdating = True
End Sub



هذا وبالله التوفيق
 
13-01-2018 07:57 مساء
icon حل مشكلة ظهور التاريخ ارقام في قائمة منسدلة في اليوزفورم | الكاتب :زيزو العجوز |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
يمكنك ايتخدام الكود التالى
Private Sub UserForm_Initialize()
Dim Arr As Variant, i As Long
  ' يمكنك استبدال الفقرة التالية بنطاق التاريخ لديك
Arr = Range("C1:C10").Value
For i = LBound(Arr, 1) To UBound(Arr, 1)
Me.ComboBox1.AddItem Arr(i, 1)
Next
End Sub


الصفحة 1 من 3 < 1 2 3 > الأخيرة »






الساعة الآن 12:39 صباحا

أعلن هنا
أعلن هنا
أعلن هنا