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

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




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

Preview

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


نتائج البحث عن ردود العضو :salim
عدد النتائج (775) نتيجة
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 صف مع وجود معادلات) لكن بالنسبة للملف عندك العملية بسيطة ولا تستأهل 





22-12-2020 02:01 مساء
icon تعديل على كود ترحيل بدون فراغات | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 الملف ثقيل و بطيء لأنّك تستعمل  Shapes لا عمل لها
جرب هذا الكود

Option Explicit
Sub translete_data()
Dim M As Worksheet
Dim F As Worksheet
Dim RO%, x%

Set M = Sheets("Main")
Set F = Sheets("Fatura")
RO = F.Cells(Rows.Count, "E").End(3).Row + 1
If M.Range("D11") = Empty Then Exit Sub

With F
      .Cells(RO, 2) = Format(M.Range("D8"), "dd/mm/yyyy hh:mm")
      .Cells(RO, 3) = M.Range("H7")
      .Cells(RO, 4) = M.Range("D11")
      
      x = 13
      
      Do Until M.Cells(x, "B") = vbNullString
               With F.Cells(RO, 5)
                 .Value = M.Cells(x, "B")
                 .Offset(, 1) = M.Cells(x, "F")
                 .Offset(, 2) = M.Cells(x, "G")
                 .Offset(, 3) = M.Cells(x, "H")
               End With
          RO = RO + 1: x = x + 1
       Loop
       
    With F.Range("A2:A" & RO - 1)
       .Formula = "=IF(B2="""","""",MAX($A$1:A1)+1)"
       .Value = .Value
    End With
End With
End Sub

الملف مرفق
 
18-12-2020 10:06 مساء
icon كود ترحيل لمطعم | الكاتب :salim |المنتدى: اكسيل اسئله واجابات
 تم التعديل على الكود كما تريد

Dim my_sheet As Worksheet
Dim Sh As Worksheet
Dim Ro_sh%, i%, Final_Ro
Dim Rg As Range
Dim Find_what As Range
Dim Bt, t%
Dim rg_Itm As Range

'++++++++++++++++++++++++++++
Sub Debut()
  Set my_sheet = Sheets("ثوابت")
  Set Sh = Sheets("مبيعات")
   Ro = my_sheet.Cells(Rows.Count, 1).End(3).Row
   Ro_sh = Sh.Cells(Rows.Count, 2).End(3).Row + 1
  Set Rg = my_sheet.Range("a3:a" & Ro)
  Set Bt = UserForm1.ActiveControl
End Sub
'++++++++++++++++++++++++++++++++
Private Sub UserForm_Click()
  With Application
  .ScreenUpdating = False
  .Calculation = xlCalculationManual
  End With

Debut
 If TypeName(Bt) <> "CommandButton" Then GoTo Bay_Bay
 If Bt.Caption Like "*صنف*" Then
       Me.T_date = ""
      For i = 2 To 5
        Me.Controls("T_" & i) = vbNullString
      Next

 Set Find_what = Rg.Find(Bt.Caption, lookat:=1)
 If Not Find_what Is Nothing Then
      
        Me.T_date = Format(Date, "[$-ar-Lb] ddd d mmm yy")
      For i = 2 To 5
          Select Case i
            Case 2: st = "  بيع: "
            Case 3: st = "  تكلفة: "
            Case 4: st = "  الوزن: "
            Case 5: st = "  التصنيف: "
          End Select
             Me.Controls("T_" & i) = _
             st & my_sheet.Cells(Find_what.Row, i)
      Next
      Set rg_Itm = Sh.Cells(5, "D").Resize(Ro_sh + 1).Find(Bt.Caption, lookat:=1)
       If Not rg_Itm Is Nothing Then
         t = rg_Itm.Row
         If Sh.Cells(t, 2) = Format(Date, "[$-ar-lb] ddd d mmm yy") Then
          Sh.Cells(t, "E") = Val(Sh.Cells(t, "E")) + 1
         End If
        
       Else
         With Sh.Cells(Ro_sh, 2)
         .Value = Format(Date, "[$-ar-lb] ddd d mmm yy")
         .Offset(, 2) = Bt.Caption
         .Offset(, 3) = 1
         .Offset(, 4) = my_sheet.Cells(Find_what.Row, 2)
         .Offset(, 5) = my_sheet.Cells(Find_what.Row, 3)
         .Offset(, 8) = my_sheet.Cells(Find_what.Row, 4)
         .Offset(, 9) = my_sheet.Cells(Find_what.Row, 5)
        End With
         
        End If 'rg_Itm isnothing
   Else
      GoTo Bay_Bay
  End If
 End If

 Final_Ro = Sh.Cells(Rows.Count, 2).End(3).Row
 If Final_Ro > 5 Then
   Sh.Range("H6:H" & Final_Ro).Formula = _
    "=IF(OR(E6="""",F6=""""),"""",PRODUCT(E6,F6))"
   Sh.Range("I6:I" & Final_Ro).Formula = _
    "=IF(OR(E6="""",G6=""""),"""",PRODUCT(E6,G6))"
'    Sh.Range("A6:A" & Final_Ro).Formula = _
' "=SUMPRODUCT(--(B6&D6=$B$6:$B6&$D$6:$D6)) &"" (""&D6&"" لهذا اليوم  )"""
  With Sh.Range("B6:K" & Final_Ro)
     .HorizontalAlignment = 1
     .InsertIndent 1
     .Borders.LineStyle = 1
     .Font.Size = 14
     .Font.Bold = True
  End With
 End If
Bay_Bay:
 With Application
  .ScreenUpdating = True
  .Calculation = xlCalculationAutomatic
 End With
End Sub

الملف مرفق

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





الساعة الآن 06:55 مساء

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