logo

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
abdelmoniem ismail لا تميز خلال هذه الفترة-- لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة توزيع المعلمين في جدول الحصص حسب النصاب بشروط اكسيل مشاريع جاهزه



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





24-07-2018 07:30 صباحاً
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس :
تاريخ الميلاد : 1-5-1989
الدعوات : 1
قوة السمعة : 6611
الاعجاب : 2
بكبسة زر واحدة نستطيع ان نعرف ما هو اخر صف غير فارغ في كل شيت
CODE

Private Sub CommandButton1_Click()
my_row
End Sub
'============== Option Explicit Dim lr Sub LastRow_In_sheet(sh_Name)     On Error Resume Next     lr = sh_Name.Cells.Find(What:="*", _                             After:=Range("A1"), _                             Lookat:=xlPart, _                             LookIn:=xlValues, _                             SearchOrder:=xlByRows, _                             SearchDirection:=xlPrevious, _                          MatchCase:=False).Row      If Err.Number <> 0 Then lr = ""      On Error GoTo 0 End Sub '=============================================== Sub my_row() Dim i% Dim lr1 Dim k%: k = Sheets.Count Sheets("sheet1").Activate lr1 = Sheets("sheet1").Cells(Rows.Count, 1).End(3).Row  If lr1 = 1 Then lr1 = 2  Sheets("sheet1").Range("a2:b" & lr1).ClearContents If k = 1 Then   Sheets("sheet1").Range("b2") = Sheets("sheet1").Name   Sheets("sheet1").Range("a2") = 2   Exit Sub  End If For i = 2 To Sheets.Count Call LastRow_In_sheet(Sheets(i)) Sheets("sheet1").Range("b" & i) = Sheets(i).Name     If IsNumeric(lr) Then         Sheets("sheet1").Range("a" & i) = lr        Else         Sheets("sheet1").Range("a" & i) = " (Empty)"     End If Next End Sub                        
 
 
  Last_row In sheets.rar   تحميل rar مرات التحميل :(27)
الحجم :(26.033) KB





look/images/icons/i1.gif معرفة اخر صف في كل ورقة
  24-07-2018 09:35 صباحاً   [1]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 2
المشاركات : 1824
الجنس :
الدعوات : 21
قوة السمعة : 20034
الاعجاب : 12
موقعي : زيارة موقعي

جزاكم الله خيرا اخى الكريم الاستاذ سليم كود رائع 3
اثراء للموضوع اقدم لكم هذا الكود ان شاء الله ينال اعجابك ويفيد الاخوه الاعضاء

CODE
Sub Alsqr()
Dim lr As Long
Dim sh As String
Dim i As Worksheet
For Each i In Worksheets
lr = i.Cells(Rows.Count, 1).End(3).Row
sh = sh & i.Name & " " & "last row is" & " " & lr & Chr(13)
Next i
MsgBox sh, vbMsgBoxRight, "أكاديمية الصقر للتدريب"
End Sub



توقيع :الصقر

اخى العضو الكريم
اذا كنت ترى ان المنتدى مفيد لك
فكن سفيرا لنا بدعوة الاخرين للانضمام معنا
فالدال على الخير كفاعله


look/images/icons/i1.gif معرفة اخر صف في كل ورقة
  24-07-2018 09:42 صباحاً   [2]
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس :
تاريخ الميلاد : 1-5-1989
الدعوات : 1
قوة السمعة : 6611
الاعجاب : 2
المشاركة الأصلية كتبت بواسطة: الصقر

جزاكم الله خيرا اخى الكريم الاستاذ سليم كود رائع 3
اثراء للموضوع اقدم لكم هذا الكود ان شاء الله ينال اعجابك ويفيد الاخوه الاعضاء

CODE
Sub Alsqr()
Dim lr As Long
Dim sh As String
Dim i As Worksheet
For Each i In Worksheets
lr = i.Cells(Rows.Count, 1).End(3).Row
sh = sh & i.Name & " " & "last row is" & " " & lr & Chr(13)
Next i
MsgBox sh, vbMsgBoxRight, "أكاديمية الصقر للتدريب"
End Sub
جزاك الله خيراً اخي حساملكن ليس من الضروي ان يكون اخر صف بتاع اخر خلية غير فارغة في العامود الاول (اقصد العامود A)




look/images/icons/i1.gif معرفة اخر صف في كل ورقة
  24-07-2018 10:14 صباحاً   [3]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 2
المشاركات : 1824
الجنس :
الدعوات : 21
قوة السمعة : 20034
الاعجاب : 12
موقعي : زيارة موقعي

تفضل اخى الكريم هذا الكود لم انتبه لفكرة الموضوع ان العمود غير محدد

CODE
Sub Alsqr()
Dim lr As Long
Dim sh As String
Dim i As Worksheet
For Each i In Worksheets
lr = i.Cells.SpecialCells(xlLastCell).Row
sh = sh & i.Name & " " & "last row is" & " " & lr & Chr(13)
Next i
MsgBox sh, vbMsgBoxRight, "أكاديمية الصقر للتدريب"
End Sub


الكود يختلف عن الكود السابق فى استبدال هذا السطر

CODE
lr = i.Cells(Rows.Count, 1).End(3).Row


بهذا السطر

CODE
lr = i.Cells.SpecialCells(xlLastCell).Row




توقيع :الصقر

اخى العضو الكريم
اذا كنت ترى ان المنتدى مفيد لك
فكن سفيرا لنا بدعوة الاخرين للانضمام معنا
فالدال على الخير كفاعله


look/images/icons/i1.gif معرفة اخر صف في كل ورقة
  24-07-2018 10:39 صباحاً   [4]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 2
المشاركات : 1824
الجنس :
الدعوات : 21
قوة السمعة : 20034
الاعجاب : 12
موقعي : زيارة موقعي

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

CODE
Sub Alsqr()
Dim lr As Long
Dim sh As String
Dim i As Worksheet
For Each i In Worksheets
On Error Resume Next
lr = 0
lr = i.Cells.Find(What:="*", After:=Range("a1"), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
sh = sh & i.Name & " " & "last row is" & " " & lr & Chr(13)
1
Next i
MsgBox sh, vbMsgBoxRight, "أكاديمية الصقر للتدريب"
End Sub



توقيع :الصقر

اخى العضو الكريم
اذا كنت ترى ان المنتدى مفيد لك
فكن سفيرا لنا بدعوة الاخرين للانضمام معنا
فالدال على الخير كفاعله


look/images/icons/i1.gif معرفة اخر صف في كل ورقة
  24-07-2018 12:06 مساءً   [5]
معلومات الكاتب ▼
تاريخ الإنضمام : 20-11-2017
رقم العضوية : 1757
المشاركات : 1765
الدولة : مصر
الجنس :
الدعوات : 2
قوة السمعة : 9685
الاعجاب : 25
بارك الله فيكم جميعا مجهود رائع وتنافس شريف -جزاكم الله كل خير



توقيع :ali mohamed ali


{ وَقُل رَّبِّ زِدْنِي عِلْمًا }
[ كن على يقين من اعمالنا نخطئ ومن اخطائنا نتعلم ولذلك لا شي مستحيل ]
ساهم دائماً فى حل أى مشكلة او أستفسار لديك مع إضافة رد بشكره
أو دعوة لمن قدم اليك المساعدة,فالجميع هنا يعمل على مساعدة
الاخرين لوجه الله وان تحتسب له اجر عند الله

look/images/icons/i1.gif معرفة اخر صف في كل ورقة
  24-07-2018 01:41 مساءً   [6]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10529
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36752
الاعجاب : 184
بارك الله فيك أخي الحبيب سليم وجزاك الله خير الجزاء
والشكر موصول للأخ الحبيب حسام خطاب
وإثراءً للموضوع هذه دالة معرفة شبيهة بالإجراء العام ويمكن استخدمها بسهولة
CODE
Sub Test_LastRow_UDF()
    MsgBox LastRow(ActiveSheet)
End Sub

Function LastRow(sh As Worksheet)
    On Error Resume Next
        LastRow = sh.Cells.Find(What:="*", After:=sh.Range("A1"), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
    On Error GoTo 0
End Function




look/images/icons/i1.gif معرفة اخر صف في كل ورقة
  24-07-2018 03:35 مساءً   [7]
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1580
الدولة : مصر
الجنس :
تاريخ الميلاد : 1-9-1995
الدعوات : 5
قوة السمعة : 10861
الاعجاب : 6
موقعي : زيارة موقعي
"تم نقل الموضوع لقسم اكسيل شروحات ودروس برجاء الانتباه لنشر الموضوعات باماكنها للحصول على الاهتمام المطلوب"
جزاك الله خيرا استاذ سليم
والشكر موصول كذلك لاساتذتى الاحباء الاستاذ حسام والاستاذ ياسر
واثراء للموضوع ايضا يمكن ببساطة استخدام الكود التالى:

CODE
Sub Alsqr()
    For Each sht In Sheets
        Cells(a + 1, 1).Value = sht.Name
        On Error GoTo 1
        Cells(a + 1, 2).Value = sht.Cells.Find("*", , , , , 2).Row: GoTo 2
1:        Cells(a + 1, 2).Value = "Empty"
2:        a = a + 1
    Next sht
End Sub




look/images/icons/i1.gif معرفة اخر صف في كل ورقة
  24-07-2018 10:48 مساءً   [8]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10529
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36752
الاعجاب : 184
الله ينور يا سمسم .. بس لي اعتراض على استخدام جمل القفز بهذا الشكل
يمكن التعامل مع الكود بهذا الشكل أفضل
CODE
Sub Test()
    Dim ws          As Worksheet
    Dim r           As Long

    For Each ws In ThisWorkbook.Worksheets
        Cells(r + 1, 1).Value = ws.Name

        If ws.UsedRange.Address = "$A$1" Then
            Cells(r + 1, 2).Value = "Empty"
        Else
            Cells(r + 1, 2).Value = ws.Cells.Find("*", , , , , 2).Row
        End If
        r = r + 1
    Next ws
End Sub




look/images/icons/i1.gif معرفة اخر صف في كل ورقة
  24-07-2018 11:12 مساءً   [9]
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1580
الدولة : مصر
الجنس :
تاريخ الميلاد : 1-9-1995
الدعوات : 5
قوة السمعة : 10861
الاعجاب : 6
موقعي : زيارة موقعي
المشاركة الأصلية كتبت بواسطة: YasserKhalil الله ينور يا سمسم .. بس لي اعتراض على استخدام جمل القفز بهذا الشكل
يمكن التعامل مع الكود بهذا الشكل أفضل
CODE
Sub Test()
    Dim ws          As Worksheet
    Dim r           As Long

    For Each ws In ThisWorkbook.Worksheets
        Cells(r + 1, 1).Value = ws.Name

        If ws.UsedRange.Address = "$A$1" Then
            Cells(r + 1, 2).Value = "Empty"
        Else
            Cells(r + 1, 2).Value = ws.Cells.Find("*", , , , , 2).Row
        End If
        r = r + 1
    Next ws
End Sub
رائع كالعادة أستاذى الحبيب ياسر
مشكور لمرورك ولمساتك الفنية التى لا غنى عنها 81




look/images/icons/i1.gif معرفة اخر صف في كل ورقة
  25-07-2018 06:18 صباحاً   [10]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 2
المشاركات : 1824
الجنس :
الدعوات : 21
قوة السمعة : 20034
الاعجاب : 12
موقعي : زيارة موقعي

الله ينور يا اسلام يا غالى حل رائع 3




توقيع :الصقر

اخى العضو الكريم
اذا كنت ترى ان المنتدى مفيد لك
فكن سفيرا لنا بدعوة الاخرين للانضمام معنا
فالدال على الخير كفاعله


look/images/icons/i1.gif معرفة اخر صف في كل ورقة
  25-07-2018 07:19 صباحاً   [11]
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10529
الجنس :
تاريخ الميلاد : 1-10-1978
الدعوات : 24
قوة السمعة : 36752
الاعجاب : 184
بارك الله فيك أخي العزيز إسلام وأخي الحبيب حسام
وأنا جد سعيد بالتفاعل في هذا الموضوع مع الأخ الرائع سليم

بالمناسبة يا حوسو جد سعيد (سعيد دا مش حفيدي ولا أنا جده .. دي معناها سعيد جداً very happy) 142




look/images/icons/i1.gif معرفة اخر صف في كل ورقة
  25-07-2018 09:56 مساءً   [12]
معلومات الكاتب ▼
تاريخ الإنضمام : 03-10-2017
رقم العضوية : 852
المشاركات : 1580
الدولة : مصر
الجنس :
تاريخ الميلاد : 1-9-1995
الدعوات : 5
قوة السمعة : 10861
الاعجاب : 6
موقعي : زيارة موقعي
مشكور تقديرك أستاذى الغالى حسام 81
وايضا جدو ياسر biggrin2




اضافة رد جديد اضافة موضوع جديد
الصفحة 2 من 2 < 1 2 >




المواضيع المتشابهه
عنوان الموضوع الكاتب الردود الزوار آخر رد
معرفة هل تم كسر أو ازالة الحماية عن ورقة عمل أباالحسن
3 1704 YasserKhalil

الكلمات الدلالية
معرفة ، ورقة ،









اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 05:28 PM