بحث مخصص من جوجل فى أوفيسنا
![]()
Custom Search
|
-
Content Count
425 -
Joined
-
Last visited
Community Reputation
213 ExcellentAbout محي الدين ابو البشر

-
Rank
Name
Profile Information
-
Gender (Ar)
ذكر
-
Job Title
ENG
Recent Profile Visitors
1,722 profile views
-
محي الدين ابو البشر started following تصحيح في كود بحث, المساعدة في تلوين الخلية, مايكرو لتغيير لون خط خلية معينة and 7 others
-
تنسيق شرطي اذا كانت الخلية فارغة "أبيض"
-
هكذا؟ نموذج.xlsm
-
مساعدة فى كود لترحيل خلية من شيت الى شيت بالتتابع
محي الدين ابو البشر replied to sparky man's topic in MS Excel
ربما 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 -
الحمد لله وشكراً لك
-
تفضل أخي الكريم بالطريقتين نسبه مئويه.xlsm نسبه مئويه.xlsx
-
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
-
بالاذن خيار آخر ترحيل المبيعات.xlsm
-
أخي العزيز انظر الكود في المرفق لعله يفيدك ولا تتردد في اي استغسار أحر تحياتي ترحيل بيانات من الاجمالي الى السابق.xls
-
حدف الصفوف التى تحتوي على كلمة VISUALISEUR بالكود VBA
محي الدين ابو البشر replied to BAbGHDADI's topic in MS Excel
بالاذن منكم ولاثراء الموضوع! 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 -
بالعودة للكود الأول يمكن تعديله 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
-
Field:=1 حسب الكود الموجود تتم التصقية على الأعمدة من A حتى M وبالتالي Field:=1 حسب العمود A إذاً فقط انت بحاجة للتعديل إلى 2،3،4 حسب العمود الذي تريد البحث والتصفية فيه
-
استبدل بـ 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
-
ما رأيك بهذا 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