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

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




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

Preview

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


نتائج البحث عن ردود العضو :salim
عدد النتائج (765) نتيجة
29-03-2021 07:11 صباحا
icon تعديل مكرو الترحيل | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 1- مجرد النظر الى الملف من ناحية زركشة الألوان الفاقعة تجعل من
          يريد المساعدة ينفر من ذلك
2- لا احد يعمل مع جداول فارغة 
لذلك نضيحة كي تلقي المساعدة:
1- تنسيقات عادية للخلايا
2- املأ الجداول (10 الى 15 صف في كل منها) ببيانات عشوائية
 
28-03-2021 12:07 مساء
icon كود ترحيل صف من شيت لأخر بناء على قيمة خلية | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الكود

Option Explicit
Sub trans_data()
Const mot$ = "DELIVERED"
Dim Source_Sheet As Worksheet
Dim Target_Sheet As Worksheet
Dim Rs_Copy As Range, Cel As Range
Dim dic As Object, ky
Dim Rs%, n%, Rt%
Dim arr As Variant

Set Source_Sheet = Sheets("ONGOING")
Set Target_Sheet = Sheets("DELIVERED")
Set dic = CreateObject("Scripting.Dictionary")
Set Rs_Copy = Source_Sheet.Range("a2").CurrentRegion
Rs = Rs_Copy.Rows.Count
Rt = Target_Sheet.Cells(Rows.Count, 1).End(3).Row + 1
If Rt = 2 Then Rt = 3
If Rs = 1 Then Exit Sub
Set Rs_Copy = Rs_Copy.Offset(1).Resize(Rs - 1)
For Each Cel In Rs_Copy.Columns(15).Cells
 If UCase(Cel) = mot Then
 n = n + 1
   arr = Application.Transpose(Cel.Offset(, -13).Resize(, 15))
   arr = Join(Application.Transpose(arr), "*")
   dic(n) = arr
 End If
 Next
 If dic.Count Then
    For Each ky In dic.keys
      Target_Sheet.Cells(Rt, 1) = ky
      Target_Sheet.Cells(Rt, 2).Resize(, 15) = _
       Split(dic(ky), "*")
      Target_Sheet.Cells(Rt, "Q") = Date
      Rt = Rt + 1
    Next
 End If
 
End Sub


الملف مرفق
27-03-2021 09:51 صباحا
icon كود ترحيل من الليست بوكس الي الشيت | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 لا أعلم اذا كان هذا ما تريده

Private Sub Cmd_Clera_Click()
Me.ListBox1.Clear
End Sub
'+++++++++++++++++++++++++++++++++++++++++++++++

Private Sub CommandButton1_Click()
 For I = 1 To 9
 Me.Controls("TextBox" & I) = _
  Chr(Application.RandBetween(65, 90)) & " " & _
  Chr(Application.RandBetween(65, 90))
 Next
End Sub
'++++++++++++++++++++++++++++++++++++++++++++++

Private Sub ADD_To_shett_Click()
If Me.ListBox1.ListCount = 0 Then Exit Sub
Dim z%
 With Sheets("sheet1")
 z = .Cells(Rows.Count, 1).End(3).Row + 1
   .Cells(z, 1).Resize(ListBox1.ListCount, 9).Value = _
    ListBox1.List
 End With
End Sub
'++++++++++++++++++++++++++++++++++++++++++++++++
Private Sub ADD_To_list_Click()
Dim n As Byte, t, k%
For t = 1 To 9
 If Me.Controls("TextBox" & t) <> vbNullString Then
 k = k + 1
End If
Next
 If k Then
With Me.ListBox1
   .AddItem
     For n = 0 To .ColumnCount - 1
    .List(.ListCount - 1, n) = _
     Me.Controls("TextBox" & n + 1)
    Next
   End With
 End If
End Sub


الملف مرفق
26-03-2021 11:08 صباحا
icon مسح بيانات من نطاق مرن متغير | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الماكرو (يقوم باخفاء الصفوف وليس حذفها)
        (اذا كنت تريد الحذف يمكن التعديل)

Sub My_Macro()

Dim LASTROW
Dim Rg As Range
Dim Impt
Dim Sh As Worksheet
Set Sh = Sheets("ElectronicPayment")
Show_ALL

LASTROW = Sh.Cells(Rows.Count, 1).End(3).Row

Impt = Application.InputBox("Put an Number <= " & LASTROW _
       , 1, Type:=1)
  If Val(Impt) <= 0 Or CInt(Impt) > LASTROW Then
   MsgBox "You must type Only number<=  " & LASTROW
   Exit Sub
  
  End If
  Impt = Int(Impt)
 Set Rg = Sh.Range("A" & Impt).Resize(LASTROW - Impt + 1, 7)
 Rg.EntireRow.Hidden = True
 
End Sub
'+++++++++++++++++++++++++++++++++++++++
Sub Show_ALL()
Sheets("ElectronicPayment").Rows.Hidden = False
End Sub

الملف مرفق
24-03-2021 08:57 مساء
icon كود لترحيل البيانات لاعمدة مختلفة الترتيبكود لترحيل البيانات لاعمدة مختلفة الترتيب | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 كنت قد وضعت موضوعاً جول الــServer لهذا المنتدي و انه في أغلب الأحيان 70% تظهر هذه العبارة على الــBrowser
This site can’t be reached  والان النسبة اصبحت 90%
ولاحياة لمن تنادي   اي لم يرد على تساؤلاتي من المسؤولين عن الموقع
لهذا اذا استمر هذا الوضع سأقوم (آسفاً) بتعليق عضويتي في الموقع

الكود من جديد (الصفحات الباقية ليست محذوفة بل تم اخفاءها
لمراقبة عمل الكود)

Sub My_Data()

Dim A, D    As Worksheet
Dim RD%, RA%, I%, K%
Dim Ar_A(), Ar_D()
Set A = Sheets("Atten")
Set D = Sheets("Daily ENT")
RD = D.Range("D7").Resize(500).Find("", LookIn:=xlValues).Row - 1
RA = A.Cells(Rows.Count, "D").End(3).Row + 1
If RA < 7 Then RA = 7
'-----------------------------------------------------
 Ar_A = Array("D", "E")
 Ar_D = Array("D", "C")

For K = 7 To RD
   For I = 0 To 1
      A.Cells(RA, Ar_A(I)) = _
      D.Cells(K, Ar_D(I))
   Next I
     A.Cells(RA, I + 4).Resize(, 7).Value = _
   D.Cells(K, "F").Resize(, 7).Value
 RA = RA + 1
Next K
End Sub

 
22-03-2021 01:34 مساء
icon كود لترحيل البيانات لاعمدة مختلفة الترتيب | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الكود

Sub My_Data()

Dim N, D    As Worksheet
Dim RD%, RN%, I%, K%
Dim Ar_N(), Ar_D()

Set N = Sheets("New")
Set D = Sheets("Data")

RD = D.Cells(Rows.Count, "C").End(3).Row
RN = N.Cells(Rows.Count, "D").End(3).Row + 1
If RN < 7 Then RN = 7
'-----------------------------------------------------
 Ar_N = Array("D", "E")
 Ar_D = Array("D", "C")

For K = 7 To RD
   For I = 0 To 1
      N.Cells(RN, Ar_N(I)) = _
      D.Cells(K, Ar_D(I))
   Next I
  
   N.Cells(RN, I + 4).Resize(, 7).Value = _
   D.Cells(K, "F").Resize(, 7).Value
 RN = RN + 1
Next K

End Sub


الملف مرفق
 
16-03-2021 06:45 صباحا
icon كود لنسخ بيانات من ملف اسمه ومساره غير ثابت الى ملف اخر | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الكود
يحدد لك عدد المصنفات المفنوحة ما عدا المصنف الرئيسي
و يفترض ان  الملف المصدر ( المراد النسخ منه ) هو أول واحد منها

Option Explicit

Sub How_Many_Opened_Books()
Dim P%, Other_Path$
Dim Coll As New Collection
Dim Main_Book As Workbook
Dim Other_Book As Workbook
    
    For P = 1 To Application.Workbooks.Count
     If Workbooks(P).Name <> ThisWorkbook.Name Then
       Coll.Add Workbooks(P).Name
     End If
    Next
 
 If Coll.Count = 0 Then Exit Sub
    Set Main_Book = ThisWorkbook
    Set Other_Book = Workbooks(Coll(1))
    MsgBox Other_Book.Name
    Other_Path = Other_Book.Path
    MsgBox Other_Path
End Sub


 
11-03-2021 09:44 صباحا
icon طلب مساعدة بخصوص طباعة من يوزر فوورم | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 Application.Visible = False
هذه العبارة خطيرة جداً لانها تخفي الExcel بالكامل ولا تخفي الورقة كما تعتقد
عند استعمالها لا يمكنك رؤية برنامج الاكسل حتى ولو قمت بفتح مصنف جديد
اذن انت هنا تخفي الـــ Application التي هي الــ Excel فكيف تطلب الطباعة
15-02-2021 07:09 صباحا
icon استخراج الرقم الاقل | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 Try This code

Option Explicit
Sub fin_min()
Dim arr(), m, i, Mn
    For i = 2 To 7
      If Cells(i, 1) < Cells(2, 3) Then
        ReDim Preserve arr(m)
        arr(m) = Cells(i, 1)
        m = m + 1
      End If
    Next
If m > 0 Then
    Mn = Application.Min(Application.Max(arr), Cells(2, 3))
    MsgBox Range("a2:a7").Find(Mn, lookat:=1).Address
End If
End Sub
12-02-2021 08:28 صباحا
icon بحث بالاسم في جميع الشيتات عن طريق اليوزر فورم | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الملف
qWKZo_My_User
08-02-2021 09:33 صباحا
icon طباعة الصفوف الثلاثة الأولى المخفية | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 Try This Code

Option Explicit
Sub Hide_then_Print()
Dim LR%
 
 With Sheets("موازنة 2020")
   LR = .Cells(Rows.Count, 1).End(3).Row
  .Rows("1:3").Hidden = False
  .PageSetup.PrintArea = _
  .Range("A1:F" & LR).Address
  
  .PrintPreview             ' <<<==== Change to .PrintOut
  
  .Rows("1:3").Hidden = True
  End With
End Sub
31-01-2021 07:38 صباحا
icon دالة جمع البيانات بشرط أن تكون في حدود تاريخ معين أو ما قبله | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 this Formula

=SUMPRODUCT(($D$11:$D$38<=$F$3)*G$11:G$38)

 

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





الساعة الآن 02:58 مساء

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