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

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




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

Preview

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


نتائج البحث عن ردود العضو :ابراهيم الحداد
عدد النتائج (188) نتيجة
25-03-2021 01:43 مساء
icon كود ترحيل من الليست بوكس الي الشيت | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
استبدل ذلك السطر
Z=3

بهذا السطر
        Z = Sheet1.Range("A" & Rows.Count).End(3).Row

وقم بالغاء هذا السطر
 Z=Z+1
و هكذا مع باقى الاكواد
01-03-2021 01:35 صباحا
icon ترحيل بيانات معينة | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
استخدم هذا الكود
Sub TrnsfrData()
Dim Dta As Worksheet, ws As Worksheet
Dim Arr As Variant, Temp As Variant
Dim Rng As Range, i As Long, j As Long, p As Long
Dim StrDate As String, C As Range
Const NewInput As String = "دخول جديد"
Const Remov As String = "شطب"
Const ChngCas As String = "تغيير الصفة"

Set Dta = Sheets("data")
Set ws = Sheets("حركة التلاميذ")
T = Timer
Application.ScreenUpdating = False
ws.Range("A11:K30").ClearContents
Set Rng = Dta.Range("A7:U26")
StrDate = ws.Range("G6")
Arr = Rng.Value
ReDim Temp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Arr(i, 18) = StrDate Or Arr(i, 19) = StrDate Then
p = p + 1
For j = 1 To 10
Temp(p, j) = Arr(i, Choose(j, 1, 2, 3, 6, 7, 8, 9, 14, 20, 21))
Temp(p, 1) = p
Next
End If
Next
If p > 0 Then ws.Range("A11").Resize(p, UBound(Temp, 2)).Value = Temp
For Each C In ws.Range("I11:I30")
If Not IsEmpty(C) And Not IsEmpty(C.Offset(0, 1)) Then
C.Offset(0, 2) = ChngCas
ElseIf Not IsEmpty(C) Then
C.Offset(0, 2) = NewInput
ElseIf Not IsEmpty(C.Offset(0, 1)) Then
C.Offset(0, 2) = Remov
Else
C.Offset(0, 2) = Empty

End If
Next
Application.ScreenUpdating = True
MsgBox Round(Timer - T, 2)
End Sub
15-02-2021 12:49 صباحا
icon استخراج الرقم الاقل | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
استخدم هذا الكود
Sub SelcRnge()
Dim C As Range, x As Double
For Each C In Range("A2:A" & Range("A" & Rows.Count).End(3).Row)
x = Range("C2").Value
If C.Value < x Then
C.Select
End If
Next
End Sub
30-01-2021 11:29 مساء
icon الترحيل بشرط معين بالمصفوفات | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
استخدم هذا الكود
Private Sub CommandButton14_Click()
Dim Imprt As Worksheet, TodyImpt As Worksheet
Dim LR As Long, LS As Long, i As Long, j As Long, p As Long
Dim Arr As Variant, Tmp As Variant
Dim Dat As Date, Cridr As String
Set Imprt = Sheets("الوارد")
Set TodyImpt = Sheets("الوارد_اليوم")
Dat = Me.TextBox16.Value: Cridr = Me.ComboBox3.Text
LR = Imprt.Range("B" & Rows.Count).End(3).Row
LS = TodyImpt.Range("B" & Rows.Count).End(3).Row

Arr = Imprt.Range("A10:H" & LR).Value
ReDim Tmp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Arr(i, 2) = Dat And Arr(i, 8) = Cridr Then
p = p + 1
For j = 1 To 8
Tmp(p, j) = Arr(i, j)
Tmp(p, 1) = p
Next
End If
Next
If p > 0 Then TodyImpt.Range("A" & LS + 1).Resize(p, UBound(Tmp, 2)).Value = Tmp


End Sub
30-01-2021 01:07 مساء
icon البحث عن طريق الدالة vlookup | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
ربما تقصد هذه المعادلة 
و الله اعلى و اعلم
=IF(OR(A11="";A11=YEAR(NOW()));"";A11+1)
29-01-2021 01:18 مساء
icon البحث عن طريق الدالة vlookup | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
تفضل
 
27-01-2021 01:37 مساء
icon البحث عن قيمة خلية بمرجع خلية اخرى | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
استخدم المعادلة التالية بحيث يتم وضعها بنفس الصف المتواجد به اول قيمة 
=IF(COUNTIF(C$2:$C3;$C3)<COUNTIF($C$2:$C$10000;$C3);"";$D3)
25-01-2021 03:06 مساء
icon تعديل كود استدعاء من ملف مغلق الحلقة التكرارية تجعله ياخد وقت طويل جدااا | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
ربما يفيدك هذا الكود 
هذا و الله اعلى و اعلم
Sub CopyRange()
t = timr
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.DisplayClipboardWindow = False
    Dim desWS As Worksheet, srcWB As Workbook, s As String
    Set desWS = ThisWorkbook.Sheets("ورقة1")
    Dim LastRow As Long
'   Const strPath As String = "E:\ClosedFiles\افضل حل\do\"
    Dim strPath As String
    strPath = ThisWorkbook.Path & "\do\"
    ChDir strPath
    strExtension = Dir(strPath & "*.xls*")
    Do While strExtension <> ""
        s = FileLastModified(strPath & strExtension)
        Set srcWB = Workbooks.Open(strPath & strExtension)
        With srcWB.Sheets("ورقة1")
            LastRow = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
            .Range("A2:I" & LastRow).Copy
            With desWS
                .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            End With
        End With
        srcWB.Close False
        strExtension = Dir
    Loop
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
'MsgBox Round(Timer - t, 2)
End Sub
Function FileLastModified(StrFileName As String)
    Dim fs As Object, f As Object, s As String
    Set fs = CreateObject("Scripting.FileSystemObject")
    Set f = fs.GetFile(StrFileName)
    s = UCase(StrFileName) & vbCrLf
    Set fs = Nothing: Set f = Nothing
End Function

 
23-01-2021 01:30 مساء
icon تعديل كود استدعاء من ملف مغلق الحلقة التكرارية تجعله ياخد وقت طويل جدااا | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
جربى هذا الكود ربما يكون هذا ما تقصدين
Sub Trans1()
Dim ph As String
Dim wb As String
Dim Rng As String
Dim xx
t = Timer
Application.ScreenUpdating = False
ph = ThisWorkbook.Path & "\do\"
wb = "من" & ".xlsx"
Rng = "A1:G10000"
    ' ازالة كل البيانات بالشبت الحالى
Sheets("ورقة1").Range("A2:G10000").ClearContents
    'تسمية المسار الذى سيتم جلبه
xx = "='" & ph & "[" & wb & "]" & "'!" & Rng
    ' جلب البيانات و تحديد عدد الصفوف والاعمدة المطلوبة
With Sheets("ورقة1").Range("A2").Resize(10000, 7)
.Value = xx
     ' ازالة المعادلات و الاحتفاظ بقيمها
.Value = .Value
End With
     ' الغاء القيم الصفرية
ActiveWindow.DisplayZeros = False
Application.ScreenUpdating = True
'MsgBox Round(Timer - t, 2)
End Sub
19-01-2021 11:35 مساء
icon كود لترحيل المدين والدائن وتقرير استدعاء بيانات عن طريق اختيار بيانات التقريروتاريخ فترة | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
اختى الكريمة على حسب ما فهمت
الكود الآتى لترحيل البيانات من ورقة  الادخال والترحيل الى الى باقى الاوراق حسب الخليىة "G2"
اما غير ذلك صراحة لم افهم ربما بفهمه احد الزملاء و يقوم بعمله
راجيا لك كل التوفبق
Sub TranserData()
Dim ws As Worksheet, Sh As Worksheet
Dim Lr As Long, Ls As Long, ShNam As String
Dim Arr As Variant, Tmp As Variant, i As Long, j As Long, p As Long
Dim a, b
Set ws = Sheets("الادخال والترحيل")
Lr = ws.Range("C" & Rows.Count).End(3).Row
a = ws.Range("A2"): b = ws.Range("B2")
ShNam = ws.Range("G2")
Set Sh = Sheets(ShNam)
Ls = Sh.Range("B" & Rows.Count).End(3).Row
Arr = ws.Range("A3:F" & Lr).Value
ReDim Tmp(1 To UBound(Arr, 1), 1 To UBound(Arr, 2))
For i = 1 To UBound(Arr, 1)
If Arr(i, 5) > 0 Or Arr(i, 6) > 0 Then
p = p + 1
For j = 1 To UBound(Arr, 2)
Tmp(p, j) = Arr(i, Choose(j, 1, 3, 3, 4, 5, 6))
Tmp(p, 1) = a
Tmp(p, 3) = b
Next
End If
Next
Sh.Range("A" & Ls + 1).Resize(p, UBound(Tmp, 2)).Value = Tmp
End Sub

12-01-2021 01:21 مساء
icon مشكلة في كتابة التاريخ عند جمع خليتين | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
اجعلها هكذا
="السن في " & TEXT(A$1;"dd/mm/yyyy")
09-12-2020 12:52 مساء
icon كود الاستاذ الفاضل علي محمد لجعل الخانه لا يكتب فيها سوى 4 ارقام | الكاتب :ابراهيم الحداد |المنتدى: اكسيل اسئله واجابات
 السلام عليكم ورحمة الله
فى الكود المدرج فى حدث Sheet2
استبدل كلمة  "Left" بكلمة  "Right"
و ينتهى الامر باذن الله 

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





الساعة الآن 12:10 مساء

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