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


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


نتائج البحث عن ردود العضو :سوزي كارم
عدد النتائج (37) نتيجة
18-10-2017 11:03 مساء
icon كنترول لجميع المراحل التعليمية وجميع الصفوف على النظام الحديث 2018 | الكاتب :سوزي كارم |المنتدى: اكسيل اسئله واجابات
 الرابط من اسوا الروابط مش عارف احمل الملف .. نريد الملف على منتدانا الغالي او رابط اخر سهل
17-10-2017 11:11 مساء
icon استخراج القيم الغير مكررة (القيم الفريدة) | الكاتب :سوزي كارم |المنتدى: اكسيل اسئله واجابات
 


'Private Sub Worksheet_Activate()


    Dim ws          As Worksheet
    Dim rng         As Range
    Dim a           As Variant

    Const strTRng   As String = "T4"
    Const strHRng   As String = "T4:T1000"
    Const strSRng   As String = "V7:V500"
    Const str       As String = "بيانات الطلبة"

    Set ws = Sheets(str)
    Set rng = ws.Range(strSRng)
    ActiveSheet.Range(strHRng).ClearContents

    a = GetDistinct(rng)

    ActiveSheet.Range(strTRng).Resize(UBound(a, 1) + 1) = Application.Transpose(a)
    [T4:T200].Sort [T4], xlAscending

    With ActiveSheet.Range(strHRng)
        .EntireColumn.NumberFormat = "@"
        .Font.Bold = True
        .ReadingOrder = xlRTL: .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
    End With
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
    Application.EnableEvents = False

    
End Sub

Function GetDistinct(ByVal oTarget As Range) As Variant
    Dim dic         As Object
    Dim vArr        As Variant
    Dim v           As Variant

    Set dic = CreateObject("Scripting.Dictionary")
    vArr = oTarget

    For Each v In vArr
        If Not IsEmpty(v) Then dic(v) = CStr(v)
    Next v

    GetDistinct = dic.Items()
       Application.ScreenUpdating = True
   Application.Calculation = xlCalculationAutomatic
   Application.EnableEvents = True

End Function



مازالت الهزه .. ارجو ضبطها
17-10-2017 10:00 مساء
icon فرز قوائم الفصول | الكاتب :سوزي كارم |المنتدى: اكسيل اسئله واجابات
 
لرفع الموضوع
17-10-2017 09:18 صباحا
icon فرز قوائم الفصول | الكاتب :سوزي كارم |المنتدى: اكسيل اسئله واجابات
 استاذ محمود الشريف
انت استاذ في الشرح  يعزك الله
17-10-2017 02:31 صباحا
icon فرز قوائم الفصول | الكاتب :سوزي كارم |المنتدى: اكسيل اسئله واجابات
17-10-2017 02:30 صباحا
icon فرز قوائم الفصول | الكاتب :سوزي كارم |المنتدى: اكسيل اسئله واجابات
 استاذ خالد الرشيدي
يحفظك الله ويعزك
في مرفقي هذا اضفت عمود في صفحه الفصول فارجو تضبيط كودك الموجود بالمرفق
 
16-10-2017 08:01 مساء
icon فرز قوائم الفصول | الكاتب :سوزي كارم |المنتدى: اكسيل اسئله واجابات
 واذا اردنا ان نجعل نصف  قائمه الفصل اكثر من 30 ماهو التغيير في الكود ؟
15-10-2017 03:01 مساء
icon كود ب3 معايير | الكاتب :سوزي كارم |المنتدى: اكسيل اسئله واجابات
 
If DATA.Cells(i, 101) Like targt & "*" And    DATA.Cells(i, 104) Like targt2 & "*" And   DATA.Cells(i, 103) Like targt3 & "*" And c = 0
If Data.Cells(i, 101) Like targt & "*" And Data.Cells(i, 104) Like targt2 & "*" And Data.Cells(i, 103) Like targt3 & "*" And c = 0 Then


تمام
15-10-2017 11:36 صباحا
icon كود ب3 معايير | الكاتب :سوزي كارم |المنتدى: اكسيل اسئله واجابات
 
If DATA.Cells(i, 101) Like targt & "*" And    DATA.Cells(i, 104) Like targt2 & "*" And   DATA.Cells(i, 103) Like targt3 & "*" And c = 0

بهذا الشكل ؟
14-10-2017 09:59 مساء
icon كود ب3 معايير | الكاتب :سوزي كارم |المنتدى: اكسيل اسئله واجابات
 
 If DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And DATA.Cells(i, 104) Like targt3 & "*"And c = 0 Then 

هل تركيب هذه الجمله صحيح ؟
14-10-2017 06:19 مساء
icon كود ب3 معايير | الكاتب :سوزي كارم |المنتدى: اكسيل اسئله واجابات
 ماسبق كود بمعيارين
نريد زياده معيار اخر
14-10-2017 03:24 مساء
icon الفرق بين Const و ( Dim و Set ) | الكاتب :سوزي كارم |المنتدى: اكسيل اسئله واجابات
 
Sub sajida()
'هذا الكود للنابغه ساجدة العزاوي
'الهدف من الكود هو استخراج الشهادات
'كل 4 شهادات في صفحه واحدة
'بمعيارين
'=*=*=*=*=*
 Dim SHehada As Worksheet, DATA As Worksheet
    Set DATA = Worksheets("رصد الترم الثانى")    'اسم شيت قاعدة البيانات
    Set SHehada = Worksheets("4شهادات")    'اسم الشيت الخاص بالشهادات
    Dim myArray, targt, targt2
    targt = "ناج*"    'خلية البحث
    targt2 = "ول*"
'===================
c = 0
Application.ScreenUpdating = False
    lr = DATA.Cells(Rows.Count, 2).End(xlUp).Row   'اخر صف به بيانات

' عدد الصفوف الخارجة عن التوزيع في ورقة مصدر البيانات
       For i = 7 To lr
    '=======
If DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 0 Then
     Range("M3") = DATA.Cells(i, 2)
            c = c + 1
            '===
            
   ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 1 Then
     Range("M19") = DATA.Cells(i, 2)
            c = c + 1
   ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 2 Then
   

     Range("M35") = DATA.Cells(i, 2)
            c = c + 1
   ElseIf DATA.Cells(i, 101) Like targt & "*" And DATA.Cells(i, 104) Like targt2 & "*" And c = 3 Then
     SHehada.Range("M51") = DATA.Cells(i, 2)
            c = c + 1
            End If
            
    If i = lr And c = 4 Then SHehada.Range("a1:p63").PrintOut: Exit For
    If i = lr And c = 3 Then SHehada.Range("a1:p47").PrintOut: Exit For
    If i = lr And c = 2 Then SHehada.Range("a1:p31").PrintOut: Exit For
    If i = lr And c = 1 Then SHehada.Range("a1:p15").PrintOut: Exit For
    If i < lr And (Range("M19") = "" Or Range("M35") = "" Or SHehada.Range("M51") = "") Then GoTo 1
    If i < lr And c = 4 Then SHehada.Range("a1:p63").PrintOut
      c = 0
     Range("M3") = ""
     Range("M19") = ""
     Range("M35") = ""
     Range("M51") = ""
    
1:
   Next i
     Range("M3") = ""
     Range("M19") = ""
     Range("M35") = ""
     Range("M51") = ""
   Application.ScreenUpdating = True
End Sub

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





الساعة الآن 04:40 صباحا