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

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




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


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


نتائج البحث عن ردود العضو :salim
عدد النتائج (379) نتيجة
27-11-2019 08:30 مساء
icon كود تجميع البيانات | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 تم معالجة الامر

Option Explicit
Dim i%, col%, ro%, k%, S#
Dim nam
Dim my_rg As Range
Dim cop_rg As Range
Dim sh As Worksheet
Const st$ = "التاريخ"
Sub get_data()
Set cop_rg = Sheets("sheet1").Range("T5").CurrentRegion
col = cop_rg.Columns.Count
Range("a1").Resize(100, col).Clear
 For i = 2 To Sheets.Count
   With Sheets(i)
   .Name = Replace(Sheets(i).Name, "|", "")
   .Name = Sheets(i).Name & "|"
   End With
  Next
For i = 1 To Sheets.Count - 1

cop_rg.Copy Sheets("sheet1").Cells(5 + 6 * (i - 1), 1)
 With Sheets("sheet1").Cells(3 + 6 * (i - 1), "H")
  .Value = Sheets(i + 1).Name
  .Offset(, -1) = st
 End With
Next
ro = Sheets("sheet1").Cells(Rows.Count, 1).End(3).Row
 For i = 6 To ro Step 6
   nam = Sheets("sheet1").Cells(i - 3, "h")
   Sheets("sheet1").Cells(i - 3, "h") = _
   Replace(Sheets("Sheet1").Cells(i - 3, "h"), "|", "")
  Set sh = Sheets(nam)
  ro = sh.Cells(Rows.Count, 4).End(3).Row
   For k = 4 To col + 2
      S = Application.Sum(sh.Range(sh.Cells(7, k), _
       sh.Cells(ro - 1, k)))
       
       With Sheets("sheet1").Cells(i, 2)
        .Offset(, k - 4) = S: S = 0
        .Offset(1, k - 4) = sh.Cells(ro, k)
       End With
    Next k
 Next i
  For i = 2 To Sheets.Count
    Sheets(i).Name = Replace(Sheets(i).Name, "|", "")
   Next
End Sub

الملف من جديد
 
27-11-2019 02:13 مساء
icon كود تجميع البيانات | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الكود (يعطي المجاميع من كل عامود) حسب ما فهمت من المشاركة

Option Explicit
Sub My_macro()
  Dim col%, i%, last_ro%, k%
  Dim sh As Worksheet
  Dim s#, t#
  Dim arr()

ReDim arr(1 To Sheets.Count - 1)
 For i = 1 To Sheets.Count - 1
  arr(i) = Sheets(i + 1).Name
 Next
col = Sheets("Sheet1").Cells(6, Columns.Count).End(1).Column
Sheets("Sheet1").Range("d7").Resize(2, col - 3).ClearContents
 For i = 2 To col - 2
      For k = LBound(arr) To UBound(arr)
        Set sh = Sheets(arr(k))
        last_ro = sh.Cells(Rows.Count, 4).End(3).Row
        t = t + sh.Cells(last_ro, i + 2)
        s = s + Application.Sum(sh.Range(sh.Cells(7, i + 2), _
         sh.Cells(last_ro - 1, i + 2)))
      Next k
      With Sheets("Sheet1").Cells(7, i + 2)
       .Value = s: s = 0
       .Offset(1) = t: t = 0
      End With
Next i
Erase arr
End Sub

الملف مرفق
24-11-2019 01:37 مساء
icon نسخ ارقام فى فى خلايا الى خلايا اخرى بدون فارغات | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 Try this file
 
20-11-2019 07:19 صباحا
icon ليست بوكس تعديل طريقة البحث | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 ربما كان هذا المطلوب
عند الضغط على زر البحث تظهر لك رسالة تطلب تحديد العامود الذي تريد البحث فيه
A,B,C الخ.
الكود

Private Sub CommandButton4_Click()
Dim i%, ii%, LR%, LastRow%, t%, R%, y%
Dim Where
MY_List.Clear
With sheet2
Where = InputBox("Choose Columns", , "C")
   Select Case UCase(Where)
   Case "A": y = 1
   Case "B": y = 2
   Case "C": y = 3
   Case "D": y = 4
   Case "E": y = 5
   Case "F": y = 6
   Case "G": y = 7
   Case Else: Exit Sub
  End Select
LastRow = .Cells(.Rows.Count, y).End(xlUp).Row
    For R = 2 To LastRow
        If .Cells(R, y) Like "*" & MY_Text.Text & "*" Then
            MY_List.AddItem
             For ii = 0 To 5
              MY_List.List(t, ii) = .Cells(R, "A").Offset(, ii)
             Next
            t = t + 1
         End If
    Next
End With
End Sub

الملف مرفق
10-11-2019 08:29 مساء
icon شرح طريقة الاستاذ الترحيل المتقاطع بطريقة ديناميكية مع ياسر محمد علي | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الكود

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
If Target.Address = "$C$2" Then
get_ref
End If
Application.EnableEvents = True

End Sub
'================================
Sub get_ref()
Rem ==>> Created By Salim Hasbaya On 10/11/2019
    Dim My_Sh As Worksheet
    Dim Target_sh As Worksheet
    Dim oBJ As Object
    Dim k%, lastcol%, i%, m%: m = 13
Set My_Sh = Sheets("ورقة1")
Set oBJ = CreateObject("System.Collections.Sortedlist")

Set Target_sh = Sheets("نوبة " & My_Sh.Range("c2"))
lastcol = Target_sh.Cells(3, Columns.Count).End(1).Column
My_Sh.Range("A13", Range("B12").End(4)).ClearContents
    For i = 1 To lastcol - 9
     Randomize
     oBJ.Add Rnd(), i
    Next
 For k = 0 To oBJ.Count - 1
Cells(m, 2) = Target_sh.Cells(3, oBJ.IndexOfValue(k + 1) + 10)
Cells(m, 1) = oBJ.IndexOfValue(k + 1) + 10
        m = m + 1
   Next
End Sub

الملف مرفق
 
04-11-2019 08:49 مساء
icon عند تحديث قيمة خليه يتم وضعها بأخر خليه بالعمودعند تحديث قيمة خليه يتم وضعها بأخر خليه بالعمود | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الماكرو(بعد اذن الاخ مالك طبعاً)

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
 If Target.Address = "$B$2" Then
  Cells(2, 2).Cut Cells(Rows.Count, 4).End(3).Rows(2)
 End If
Application.EnableEvents = True
End Sub


 
02-11-2019 08:58 مساء
icon طلب عمل كود ترحيل حسب الاسم والتاريخ | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 جرب هذا الكود  (يمكنك كتابة ما تشاء في الجدول وليس بالضروري سطر واحد)

Option Explicit

Sub transfer_data()
Dim Source_sh As Worksheet
Dim Target_sh As Worksheet
Dim last_ro%, N_ro%
Set Source_sh = Sheets("ورقة1")
last_ro = Source_sh.Cells(Rows.Count, 3).End(3).Row
If last_ro < 10 Then Exit Sub
Select Case Source_sh.Range("c2")
  Case "أ": Set Target_sh = Sheets("نوبة أ")
  Case "ب": Set Target_sh = Sheets("نوبة ب")
  Case "ج": Set Target_sh = Sheets("نوبة ج")
  Case "د": Set Target_sh = Sheets("نوبة د")
  Case "ه": Set Target_sh = Sheets("نوبة ه")
  Case "و": Set Target_sh = Sheets("نوبة و")
End Select

 N_ro = Target_sh.Cells(Rows.Count, 1).End(3).Row + 1
 Target_sh.Range("a" & N_ro).Resize(last_ro - 9, 6).Value = _
 Source_sh.Range("B10").Resize(last_ro - 9, 6).Value

End Sub


الملف مرفق

 
02-11-2019 08:04 مساء
icon طلب عمل كود ترحيل حسب الاسم والتاريخ | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
  في الخلية A10 هذه المعادلة واسحب يميناً 7 أعمدة و نزولاً قدر ما تشاء

=INDIRECT("'نوبة" &" "&$C$2&"'!"&CHAR(64+COLUMNS($A$1:A1))&ROWS($A$1:A5))

الملف مرفق
 
01-11-2019 09:47 مساء
icon المساعدة فى العمليات الحسابية داخل اليوزر فورم | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 الماكرو المطوب (تحصل على النتيجة بعد الكتابة في  TextBox1 و الضغط على ENTER

Private Sub TextBox1_afterUpdate()
TextBox2.Value = _
IIf(IsNumeric(Val(TextBox1.Value)), Val((TextBox1.Value)) * 2, 0)
TextBox3 = Application.Ceiling(TextBox2.Value / 20, 0.5)
End Sub

الملف مرفق
 
31-10-2019 02:52 مساء
icon مساعدة في تعديل كود لدالة counta | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 الماكرو يجب ان يكون بهذا الشكل

Sub count_A()
Dim count_dd%
count_dd = WorksheetFunction.CountA(Range("A:A"))
Range("C1") = count_dd
End Sub
30-10-2019 04:58 مساء
icon فصل نص على عمودين | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 
كان هناك خطأ بسيط تمت معالجته(معذرة  انا لم اجرب الكود قبل رفعه)

Option Explicit
Sub Split_Text_Columns()
Application.DisplayAlerts = False
Range("F3:G" & Cells(Rows.Count, "F").End(xlUp).Row).ClearContents
   Range("E2:E" & Cells(Rows.Count, "E").End(xlUp).Row) _
   .TextToColumns Destination:=Range("F2"), OtherChar:=Chr(45)
  Application.DisplayAlerts = True
  
End Sub

الملف مرفق
لمشاهدة الروابط يلزمك التسجيل في أكاديمية الصقر للتدريب
30-10-2019 08:25 صباحا
icon فصل نص على عمودين | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 السلام عليكم
انا اقترح هذا الكود البسيط

Option Explicit

Sub Split_Text_Columns()
Application.DisplayAlerts = False
   Range("E2:E" & Cells(Rows.Count, "E").End(xlUp).Row) _
   .TextToColumns Destination:=Range("F2"), OtherChar:="-"
  Application.DisplayAlerts = True
  
End Sub


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





الساعة الآن 11:09 مساء

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