Jump to content
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

محي الدين ابو البشر

03 Special Member
  • Content Count

    425
  • Joined

  • Last visited

Community Reputation

213 Excellent

2 Followers

About محي الدين ابو البشر

  • Rank
    Name

Profile Information

  • Gender (Ar)
    ذكر
  • Job Title
    ENG

Recent Profile Visitors

1,722 profile views
  1. تنسيق شرطي اذا كانت الخلية فارغة "أبيض"
  2. تفضل أخي الكريم تم التعديل على الأكواد الموجودة لديك بيان أعمال دق وتركيب.xlsm
  3. ربما Private Sub Worksheet_Calculate() With Worksheets("AAAA").Range("A:A") Set g = .Find(Worksheets("BBBB").Range("Y7"), LookIn:=xlValues) If g Is Nothing Then Exit Sub g.Offset(, 23) = Worksheets("BBBB").Range("AG28").Value g.Offset(, 24) = Worksheets("BBBB").Range("Ah28").Value End With End Sub
  4. تفضل أخي الكريم بالطريقتين نسبه مئويه.xlsm نسبه مئويه.xlsx
  5. Sub Test() Dim a As Variant Dim ar As Range Dim i As Long Dim t For Each ar In Columns(1).SpecialCells(2, 23).Areas Set ar = ar.Offset(1).Resize(ar.Count - 1) For i = 1 To ar.Count ar(i).Offset(, 3) = Format(ar(i).Offset(, 2) / ar.Offset(, 1).Resize(1), "00%") Next ar.Resize(1).Offset(ar.Count + 2, 3) = Format(WorksheetFunction.Sum(ar.Offset(, 3)), "00%") ar.Resize(1).Offset(ar.Count + 4, 3) = Format(ar.Resize(1).Offset(ar.Count + 2, 2) / ar.Resize(1).Offset(ar.Count + 2, 1), "00%") t = t + ar.Resize(1).Offset(ar.C
  6. أخي العزيز انظر الكود في المرفق لعله يفيدك ولا تتردد في اي استغسار أحر تحياتي ترحيل بيانات من الاجمالي الى السابق.xls
  7. بالاذن منكم ولاثراء الموضوع! Sub DeleteRow() Dim i As Long Dim lr As Long Dim rr As Range Dim rrr As Range lr = Cells(Rows.Count, 1).End(xlUp).Row For i = lr To 8 Step -1 If Cells(i, 9) <> "VISUALISEUR" Then If rr Is Nothing Then Set rr = Cells(i, 9) Else Set rrr = Cells(i, 9) Set rr = Union(rrr, rr) End If End If Next rr.EntireRow.Delete End Sub
  8. بالعودة للكود الأول يمكن تعديله Sub test() Dim ar As Range Dim sh As Worksheet Dim i As Long For i = 1 To Sheets.Count If Sheets(i).Name <> "TOTAL" Then Set sh = Sheets(i) For Each ar In sh.Cells(3, 3).Resize(26).SpecialCells(xlConstants).Areas ar.Offset(, -1) = ar.Offset(, 1).Value ar.Value = 0 Next End If Next End Sub
  9. Field:=1 حسب الكود الموجود تتم التصقية على الأعمدة من A حتى M وبالتالي Field:=1 حسب العمود A إذاً فقط انت بحاجة للتعديل إلى 2،3،4 حسب العمود الذي تريد البحث والتصفية فيه
  10. استبدل بـ Sub test() Dim ar, arl As Range Dim sh As Worksheet Dim i As Long For i = 1 To Sheets.Count If Sheets(i).Name <> "TOTAL" Then Set sh = Sheets(i) For Each ar In sh.Cells(3, 4).Resize(26).SpecialCells(xlCellTypeFormulas, 1).Areas ar.Resize(ar.Count - 1).Offset(, -2) = ar.Value ar.Resize(ar.Count - 1).Offset(, -1) = 0 Set arl = ar Next arl.Resize(1).Offset(arl.Count - 2).AutoFill Destination:=arl.Resize(1, 2).Offset(arl.Count - 2, -1) End If Next
  11. ما رأيك بهذا Sub test() Dim ar As Range Dim sh As Worksheet Dim i As Long For i = 1 To Sheets.Count If Sheets(i).Name <> "TOTAL" Then Set sh = Sheets(i) For Each ar In sh.Cells(3, 3).Resize(26).SpecialCells(xlConstants).Areas ar.Offset(, -1) = ar.Value ar.Value = 0 Next End If Next End Sub ترحيل بيانات من الاجمالي الى السابق.xls
×
×
  • Create New...