اذهب الي المحتوي
أوفيسنا

ابراهيم الحداد

الخبراء
  • Posts

    1254
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    14

كل منشورات العضو ابراهيم الحداد

  1. السلام عليكم ورحمة الله اكتب الكود التالى واربطه بالزر الموجود بالملف Sub Sorting() Range("A2:S" & Range("D" & Rows.Count).End(xlUp).Row).Sort key1:=Range("K2"), order1:=xlAscending End Sub
  2. السلام عليكم ورحمة الله استبدل الكود السابق بما يلى Sub كتشنة() Range("A5:m300").Sort Key1:=Range("d5"), Order1:=xlAscending End Sub
  3. السلام عليكم ورحمة الله نعم اخى الكريم تفسيرك سليم وفى محله اذا ازلت هذه العبارة (On Error Resume Next) لن يعمل الكود معك
  4. السلام عليكم ورحمة الله تفضل اخى الكريم ترتيب وتصاعدى.rar
  5. السلام عليكم ورحمة الله اذا حدث معك هذا الامر مرة اخرى حدد الخلية (K6) ثم اضغط على (CTRL+SHIFT+ENTER) واسحب نزولا -- اليك الملف عمولة.rar
  6. السلام عليكم ورحمة الله الحمد لله الذى وفقنا لهذا ولك اخى بمثل مادعوت
  7. السلام عليكم ورحمة الله تفضل تجميع الكميات الواردة والمنصرفه على اساس كود الصنف+1111.rar
  8. السلام عليكم ورحمة الله تفضل اخى الكريم فرق بين تاريخين.rar
  9. السلام عليكم ورحمة الله انسخ الكود التالى والصقه فى موديول وخصص له زر Sub TransrerData() Dim ws As Worksheet, sh As Worksheet Dim LR As Long, LS As Long Dim R As Integer, S As Integer, p As Integer, Cod As Byte, Cod2 As Byte Dim Qty As Long, Qty2 As Long Set ws = Sheets("ÇÑÔíÝ") Set sh = Sheets("ÈíÇä ÊÌãíÚì") sh.Range("B10:K100").ClearContents Application.ScreenUpdating = False LR = ws.Range("E" & Rows.Count).End(xlUp).Row For R = 10 To LR Cod = WorksheetFunction.CountIf(Range(ws.Cells(10, "E"), _ ws.Cells(R, "E")), ws.Cells(R, "E")) If Cod = 1 Then sh.Cells(R, "B") = ws.Cells(R, "E") sh.Cells(R, "C") = ws.Cells(R, "F") sh.Cells(R, "D") = ws.Cells(R, "G") sh.Cells(R, "F") = ws.Cells(R, "I") Qty = WorksheetFunction.SumIf(Range(ws.Cells(10, "E"), ws.Cells(LR, "E")), _ sh.Cells(R, "B"), Range(ws.Cells(10, "H"), ws.Cells(LR, "H"))) sh.Cells(R, "E") = Qty End If Next LS = ws.Range("M" & Rows.Count).End(xlUp).Row p = 9 For S = 10 To LS Cod2 = WorksheetFunction.CountIf(Range(ws.Cells(10, "M"), _ ws.Cells(S, "M")), ws.Cells(S, "M")) If Cod2 = 1 Then p = p + 1 sh.Cells(p, "G") = ws.Cells(S, "M") sh.Cells(p, "H") = ws.Cells(S, "N") sh.Cells(p, "I") = ws.Cells(S, "O") sh.Cells(p, "K") = ws.Cells(S, "Q") Qty2 = WorksheetFunction.SumIf(Range(ws.Cells(10, "M"), ws.Cells(LS, "M")), _ sh.Cells(p, "G"), Range(ws.Cells(10, "P"), ws.Cells(LS, "P"))) sh.Cells(p, "J") = Qty2 End If Next Application.ScreenUpdating = True End Sub
  10. السلام عليكم ورحمة الله استخدم هذا الكود Sub TTarhil() Dim ws As Worksheet, sh As Worksheet Dim LR As Long, LQ As Long Set ws = Sheets("TD") Set sh = Sheets("DB1") LR = ws.Range("H" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False ws.Range("C11:H" & LR).Copy With sh LQ = .Range("I" & Rows.Count).End(xlUp).Row + 1 .Range("D" & LQ).PasteSpecial xlPasteValues .Range("B" & LQ) = ws.Range("G3") .Range("A" & LQ) = ws.Range("E3") .Range("C" & LQ) = ws.Range("E25") End With Application.CutCopyMode = False Application.ScreenUpdating = True End Sub
  11. السلام عليكم ورحمة الله تفضل جدول اعمدة عادل.rar
  12. السلام عليكم ورحمة الله الخطأ منى انا تفضل اخى 2017 بالاسماءكشف تفريغ الايتام.rar
  13. السلام عليكم ورحمة الله انسخ هذا الكود والصقه فى موديول جديد مخصص له زر Sub Sorting_Data() LR = Sheet1.Range("A" & Rows.Count).End(xlUp).Row Sheet2.Range("B9:M" & LR).Sort Key1:=Range("B9"), order1:=xlAscending End Sub
  14. السلام عليكم ورحمة الله تفضل اخى الكريم المصروف + الموقف = العدد المتبقي.rar
  15. السلام عليكم ورحمة الله استاذ خالد الرشيدى مجرد مرورك هو شرف
  16. السلام عليكم ورحمة الله تفضل EAA_1_2017.rar
  17. السلام عليكم ورحمة الله استاذ سليم . الملف سليم اليك المف كشف12.rar
  18. السلام عليكم ورحمة الله ضع هذا الكود فى ورقة 2 وخصص له زر Sub Tra_Data() arr = Sheet2.Range("2:175").Columns i = ActiveSheet.TextBox1 For j = LBound(arr) To UBound(arr) If Sheet2.Cells(1, j).Value = Val(i) Then Lr = Sheet2.Cells(Rows.Count, Sheet2.Cells(1, j).Column).End(xlUp).Row + 1 x = WorksheetFunction.Max(Range("L4:L" & Range("L" & Rows.Count).End(xlUp).Row)) For R = 4 To Range("L" & Rows.Count).End(xlUp).Row If Cells(R, "L") = x Then xx = Cells(R, "L").Offset(0, -1).Value Sheet2.Cells(Lr, j).Value = xx End If Next End If Next End Sub
  19. السلام عليكم ورحمة الله تفضل Salary Data.rar
  20. السلام عليكم ورحمة الله جرب هذا الملف واخبرنى بالنتيجة test.rar
  21. السلام عليكم ورحمة الله الماكرو يعمل على التاريخ الذى يكون اكبر من او يساوالتاريخ المدرج بالخلية ("J3 ") ملحوظة هامة بعض التواريخ فى الملف السنة فيها مكتوبة 1900 اليك الملف New Microsoft Office.rar
  22. السلام عليكم ورحمة الله انسخ هذا الكود و الصقه فى موديول جديد و خصص له زر Sub LastPrices1() For Each cl In Range("A3:A12") x = cl.Offset(0, 1).Value y = cl.Offset(0, 2).Value If cl.Value > Range("J3").Value And x = "بيع" Then ZZ = WorksheetFunction.VLookup(y, Range("I4:K10"), 2, 0) cl.Offset(0, 4).Value = ZZ ElseIf cl.Value > Range("J3").Value And x = "شراء" Then AA = WorksheetFunction.VLookup(y, Range("I4:K10"), 3, 0) cl.Offset(0, 4).Value = AA End If Next End Sub
×
×
  • اضف...

Important Information