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

اعلن هنا
أكاديمية الصقر للتدريب
أعلن هنا
أعلن هنا
صفحتنا على الفيس بوك
أعلن هنا

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز
المشرف المتميز
المراقب المتميز
المدير المتميز
الموضوع المتميز
القسم المتميز
Excelawy لا تميز خلال هذه الفترة لا تميز خلال هذه الفترة YasserKhalil الدليل المحاسبى الموحد اكسيل اسئله واجابات



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


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


نتائج البحث عن ردود العضو :salim
عدد النتائج (116) نتيجة
19-01-2019 12:08 مساء
icon سؤال فى معادلات الاكسل | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 
بعد اذن اخي ياسر هذه المعادلة  (Ctrl+Shift+Enter)

=LOOKUP(MAX(الحركه!$G$5:$G$100),IF(الحركه!$D$5:$D$100=$B$10,IF(الحركه!$C$5:$C$100=$A$10,ROW($H$5:$H$100)-ROW($H$5)+1)),الحركه!$F$5:$F$100)

الملف مرفق
10-01-2019 06:44 صباحا
icon مشكلة من الاحد الى السبت من كل اسبوع في الشهر اذا كان فيه اجازة وغياب تصبح الاجازة غياب | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذه المعادلة في الخلية F6  واسحب نزولاً

=CHOOSE((E6="ح")+1,"ح","غ")

 
05-01-2019 08:27 صباحا
icon حماية اعمدة معينة | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 ممكن ان يكون الحل في هذا الملف
الكود لا يسمح لك بتحديد الخلايا المحمية

Option Explicit

Sub Salim_Protection()
Dim lr As Long
With ActiveSheet
.Unprotect
 lr = .Cells(Rows.Count, 3).End(3).Row
     Cells.Locked = False
    With .Range("C1").Resize(lr, 1)
      .Locked = True
      .FormulaHidden = True
    End With
    .Protect
   .EnableSelection = xlUnlockedCells
 End With
End Sub


الملف
04-01-2019 07:04 صباحا
icon حماية اعمدة معينة | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 
جرب هذا الماكروكمثال
انه يخفي المعادلات من العامود الثالث

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("c:c")) Is Nothing Then
  Application.DisplayFormulaBar = False
Else
  Application.DisplayFormulaBar = True
End If
Application.EnableEvents = True
End Sub

 
23-12-2018 06:45 مساء
icon عملية البحث فى اكثر من شيت وعدد الاعمدة 16 | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 و هل تتوقع ان يقوم احدهم بملء بيانات لــ 16 صفحة و يقوم بتخمين عن ماذا تريد ان تبحث
و يقدم لك الحل (الذي ربما يكون صحيحاً وفي أغلب الأحيان  لا) اتها مضيعة للوقت
23-12-2018 07:02 صباحا
icon فتح شيت جديد بمجرد كتابة الإسم فى خلية | الكاتب :salim |المنتدى: اكسيل شروحات ودروس
 ممتازجدا  Mr Ali
22-12-2018 10:48 صباحا
icon كود تجميع | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 
المشاركة الأصلية كتبت بواسطة: محمود ابو الدهب »
ممكن استاذ سليم اعرف من حضرتك اسرع كيف ممكن واهو نستفيد من حضرتك ايضا 

 
​اسرع لانه يختصر حلقيتن تكراريتين من 1 الى 20 في كل صفحة(اي 20* ْعدد الصفخات *2 حلقة) بفضل هاتين المعادلتين
.Formula = "=SUM(B4:B" & i & "wink_3"

و

 
  ws.Range("B" & m).Resize(, 19).Value = _
      Rg_To_Copy.Resize(, 19).Value
20-12-2018 07:02 صباحا
icon فرز بدون تكرار | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 ممكن هذا الماكرو يقوم بالواجب

Option Explicit
Sub Unique_liste()
 Dim My_Liste As Object
 Dim Sh1 As Worksheet: Set Sh1 = Sheets("ورقة1")
 Dim Sh2 As Worksheet: Set Sh2 = Sheets("ورقة2")
 Dim rg1 As Range: Set rg1 = Sh1.Range("c6").CurrentRegion
   Dim c As Range
   Dim arr()
   
   Sh2.Range("c6").CurrentRegion.ClearContents
   Set My_Liste = CreateObject("System.Collections.ArrayList")
     With My_Liste
   For Each c In rg1
     If Not .Contains(c.Value) Then _
     .Add (c.Value)
   Next
    .Sort
    arr = .ToArray
 End With
 Sh2.Range("c6").Resize(UBound(arr) + 1) = _
 Application.Transpose(arr)
Set My_Liste = Nothing: Erase arr
End Sub

الملف
 
18-12-2018 07:32 صباحا
icon عند حدوث تغيير في بيانات رقم سيارة تتغير في كل الشيتات | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 
بعد اذن الاخ محمود 
هذا الكود ربما يكون اسرع قليلاَ حيث انه لا يعتمد على الحلقات التكرارية في كل صفحة
لانه يقوم فقط بايجاد رقم الصف المطلوب تغييره ( واذا لم يكن الرقم موجوداً ينتقل الى الصفحة التالية )

Option Explicit

Sub Salim_Changes()
Application.ScreenUpdating = False
Dim Main As Worksheet, sh As Worksheet
Dim t%, r%, my_row%
Dim My_Range As Range, My_Range1 As Range
Dim Check As Boolean
Dim myValue   As Variant

Set Main = ActiveSheet
myValue = InputBox("Give the number")
Check = IsError(Application.Match(CLng(myValue), Main.Range("a:a"), 0))
  If Check Then
    MsgBox "This data Not Exists", 64
    GoTo Leave_Me_Out
  Else
    r = Application.Match(CLng(myValue), Main.Range("a:a"), 0)
    Set My_Range1 = Main.Cells(r, 1).Resize(, 6)
  End If
 
    For Each sh In Sheets
     If sh.Name = Main.Name Then
     GoTo nxt
     End If
   
      Check = IsError(Application.Match(CLng(myValue), sh.Range("a:a"), 0))
    If Check Then
         GoTo nxt
    Else
      t = Application.Match(CLng(myValue), sh.Range("a:a"), 0)
      Set My_Range = sh.Range("a:a").Find(CLng(myValue), lookat:=xlWhole)
      my_row = My_Range.row
      sh.Cells(my_row, 1).Resize(, 6).Value = My_Range1.Value
    End If
nxt:
    Next
Leave_Me_Out:
Application.ScreenUpdating = True
End Sub

الملف مرفق
17-12-2018 06:16 مساء
icon جمع المتشابة برقم الكود في عمود B وبينهم صف فارغ | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 
جرب هذا الكود

Option Explicit
Dim arr
Sub quelque_chose()
Application.ScreenUpdating = False
Dim i%: i = 2
Dim Laste_row%
Dim MY_sh As Worksheet: Set MY_sh = Sheets("data")
Dim mY_rg As Range: Set mY_rg = MY_sh.Range("a6").CurrentRegion
Sheets("Farz").Cells.Clear
Dim rg As Object
Set rg = CreateObject("system.collections.arraylist")
With rg
 Do Until mY_rg.Cells(i, 2) = vbNullString
  If Not .contains(mY_rg.Cells(i, 2).Value) Then _
  .Add mY_rg.Cells(i, 2).Value
 i = i + 1
 Loop
 .Sort
 arr = .toarray
 End With
  For i = LBound(arr) To UBound(arr)
   mY_rg.AutoFilter 2, arr(i)
   Laste_row = Sheets("Farz").Cells(Rows.Count, 1).End(3).Row
   mY_rg.SpecialCells(12).Copy Sheets("Farz").Cells(Laste_row + 1, 1)
  Next
   mY_rg.AutoFilter
Sheets("Farz").Columns("a:l").AutoFit
find_it
Erase arr
Sheets("Farz").Range("a3").Select
Application.ScreenUpdating = True
End Sub
'=============================================

Sub find_it()
Dim rg As Range
Dim txt$
txt = "الرقم"

Dim lr%: lr = Sheets("Farz").Cells(Rows.Count, 1).End(3).Row
Dim saerch_rg As Range
Set saerch_rg = Sheets("Farz").Range("a3:a" & lr)
Set rg = saerch_rg.Find(txt, after:=Cells(lr, 1), LookIn:=xlValues, lookat:=xlPart)
 If Not rg Is Nothing Then
    rg.Resize(, 12).Clear
  Do
   Set rg = saerch_rg.FindNext(rg)
    If rg Is Nothing Then Exit Do
   rg.Resize(, 12).Clear
 Loop
  End If
End Sub

الملف مرفق الصفحة Farz
 
16-12-2018 07:16 صباحا
icon كود تجميع | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 
كود اسرع قليلاً و يقوم بعمله بمجرد فتح الشيت "الاجمالي"

Option Explicit

Sub salim_Macro()
Dim sh      As Worksheet
Dim ws      As Worksheet
Dim i       As Long

Dim Rg_To_Copy As Range
 Dim m%: m = 4
Set ws = Sheets("اجمالى")

ws.Range("b4").CurrentRegion.Offset(3).ClearContents
 For Each sh In Worksheets
   If sh.Name <> "اجمالى" Then
      i = sh.Cells(sh.Rows.Count, 8).End(xlUp).Row
      ws.Range("a" & m).Value = sh.Name
     Set Rg_To_Copy = sh.Range("H" & i)
      ws.Range("B" & m).Resize(, 19).Value = _
      Rg_To_Copy.Resize(, 19).Value
      m = m + 1
   End If
 Next sh
i = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
 ws.Range("A" & i + 1) = "المجموع"
With ws.Range("b" & i + 1).Resize(, 19)
 .Formula = "=SUM(B4:B" & i & ")"
 .Value = .Value
 End With
End Sub


الملف مرفق
 
13-12-2018 05:02 مساء
icon تفعيل اخر خلية اكسل ليس بها بيانات استعداد للكتابة عليها | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 هذا المالكرو

Private Sub Workbook_Open()

Dim My_Sh As Worksheet: Set My_Sh = Sheets("نموذج متطور")
Dim lr%: lr = My_Sh.Cells(Rows.Count, "j").End(3).Row
My_Sh.Select
Cells(lr + 1, "J").Activate
End Sub

الملق مرفق
 

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





الساعة الآن 06:36 صباحا

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