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

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




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

Preview

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


نتائج البحث عن ردود العضو :salim
عدد النتائج (765) نتيجة
26-01-2021 10:51 مساء
icon محتاج كود لشيت الطلاب فقط ادخال اختصار في خلايا العمود | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 هذا الماكرو

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Not Intersect(Target, Range("C1:C100")) Is Nothing _
 And Target.Count = 1 Then
  Select Case Target.Value
   Case 1:   Target = "ابتدائي"
   Case 2: Target = "اعدادي"
   Case Else: Target = Target
   End Select
 End If
 Application.EnableEvents = True
End Sub

الملف مرفق (تكتب 1 او  2 وتضغط  Enter/   tab / arrow/
او  تنتقل بالماوس الى خلية اخرى   او اي شيء اخر)
25-01-2021 07:19 مساء
icon كود للترحيل من شيت لاخر مع فلتره | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 زركشة ألوان فاقعة تبهر البصر
لا استطيع العمل على هكذا ملف
24-01-2021 03:22 مساء
icon تنسيق وقت | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
07-01-2021 08:38 صباحا
icon تسريع الكود | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الملف الذي لا يعتمد على الحلقات التكرارية من 1 الى 10000
بل يستعمل الدالة الرائعة FIND التي تضع يدها مباشرة على الخلية المطلوبة لمعرفة رقم الصف لهذه الخلية

Option Explicit
Dim SH2 As Worksheet, SH1 As Worksheet
Dim I As Long, RO As Long, WSLR As Long
Dim SHLR As Long, res As Long, SS As Long
Dim C As Range, K As Integer, MOT
Dim f_RG As Range, RO1%, RO2%

Private Sub UserForm_Initialize()
    Set SH1 = ThisWorkbook.Worksheets("ورقة1")
    Set SH2 = ThisWorkbook.Worksheets("ورقة2")
    WSLR = SH1.Cells(Rows.Count, 1).End(xlUp).Row
End Sub
'++++++++++++++++++++++++++++++++++++++++++
Private Sub TextBox1_Change()
WSLR = SH2.Cells(Rows.Count, 1).End(xlUp).Row

MOT = "*" & TextBox1.Value & "*"
If Len(MOT) <= 2 Then Exit Sub
If Me.ListBox1.ListIndex >= 0 Then Exit Sub
    With Me.ListBox1
        .Clear
        .ColumnCount = 4
     Set f_RG = SH2.Range("B1:B" & WSLR).Find(MOT, LOOKAT:=1)
      If Not f_RG Is Nothing Then
        RO1 = f_RG.Row: RO2 = RO1
        Do
         .AddItem
         For K = 0 To .ColumnCount - 1
         .List(.ListCount - 1, K) = SH2.Cells(RO2, 5 - K).Value
         Next
            Set f_RG = SH2.Range("B1:B" & WSLR).FindNext(f_RG)
            RO2 = f_RG.Row
            If RO2 = RO1 Then Exit Do
        Loop
      End If
    End With
End Sub
'++++++++++++++++++++++++++++++++++++++++++

Private Sub CommandButton1_Click()
    SHLR = SH1.Cells(Rows.Count, 2).End(xlUp).Row + 1
    With SH1.Range("B" & SHLR)
     .Value = TextBox1.Value: TextBox1 = ""
     .Offset(0, 1) = TextBox2.Value: TextBox2 = ""
     .Offset(0, 2) = _
      IIf(OptionButton1 = True, OptionButton1.Caption, OptionButton2.Caption)
     .Offset(0, 3) = TextBox4.Value
     TextBox4 = ""
    End With
    ListBox1.Clear

End Sub
'++++++++++++++++++++++++++++++++++++++++++

Private Sub ListBox1_Click()
 Dim X
 X = Me.ListBox1.ListIndex
 If X < 0 Then Exit Sub
   TextBox2.Text = Me.ListBox1.List(X, 2)
   Select Case True
      Case Me.ListBox1.List(X, 1) = "ابتدائي"
         OptionButton2 = True: OptionButton1 = False
      Case Else
         OptionButton2 = False: OptionButton1 = True
   End Select

   TextBox4.Text = Me.ListBox1.List(X, 0)
   TextBox1.Value = Me.ListBox1.List(X, 3)
Me.ListBox1.ListIndex = -1
End Sub

الملف مرفق
 
06-01-2021 08:21 مساء
icon دمج عدة خلايا في خلية واحدة | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 l5CbB_ARRAY
افعل ما في هذه الصورة
 
06-01-2021 06:40 مساء
icon دمج عدة خلايا في خلية واحدة | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذه الكود

Option Explicit

Sub concat()
Dim ar(), Itm
Dim stR$
Sheets("Feuil1").Range("N11").ClearContents
ar = Array("H5", "D11", "H11", "C12", "F12", "H12" _
, "i12", "E15", "F15", "G15", "K15", "G17", "H17", "J17")
  For Each Itm In ar
   stR = stR & " " & Sheets("Feuil1").Range(Itm)
  Next
Sheets("Feuil1").Range("N11") = stR
End Sub

الملف مرفق
01-01-2021 07:30 مساء
icon ضرب القروش والجنيهات | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 في الخلية D3 هذه المعادلة  واسحب نزولاً

=MOD((B3*100+A3)*C3,100)

في الخلية E3 هذه المعادلة واسحب نزولاً

=QUOTIENT((B3*100+A3)*C3,100)

الملف مرفق
 
31-12-2020 07:09 مساء
icon ترقيم معين لخلايا غير فارغة | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 هذه اسهل حاجة
العامود I
31-12-2020 06:18 مساء
icon ترقيم معين لخلايا غير فارغة | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 ربما هذا الشيء العامود H
 
31-12-2020 05:18 مساء
icon ترقيم معين لخلايا غير فارغة | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 هل نقصد هذا الشيء
 
23-12-2020 09:14 صباحا
icon اظهار الفاتورة داخل الفورم | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 1- يجب ازالة كافة الخلايا المدمجة من الأعمدة   A  حتى D
كي يعمل الماكرو بشكل صحيح (كما في الملف المرفق)

2- اضافة صف فارغ تماماً  (الصف رقم 13 مخفي)
3- عندما تغير اي شيء في الجدول وتضغط Enter
   أو تنتقل الى خلية اخرى  يظهر اليوزر
4-عندما تغير اي شيء خارج الجدول 
 أو تنتقل الى خلية اخرى وتضغط  Enter يختفي اليوزر

 
22-12-2020 06:39 مساء
icon تعديل على كود ترحيل بدون فراغات | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 يمكن استعمال هذا الشيء طبعاَ اذا كانت البيانات كبيرة جداً (اكثر من 1000 صف مع وجود معادلات) لكن بالنسبة للملف عندك العملية بسيطة ولا تستأهل 






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





الساعة الآن 04:19 مساء

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