-
Posts
13,165 -
تاريخ الانضمام
-
تاريخ اخر زياره
-
Days Won
412
نوع المحتوي
المنتدى
مكتبة الموقع
معرض الصور
المدونات
الوسائط المتعددة
كل منشورات العضو ياسر خليل أبو البراء
-
نتيجة اجمالي بيانات من صفحات في صفحة حسب الفترة
ياسر خليل أبو البراء replied to حسين مامون's topic in منتدى الاكسيل Excel
إليك رابط القناة حاول تتابعها وتستفيد منها بأكبر قدر وإن شاء الله مع الوقت تقدر تكتب أكواد بنفسك .. الموضوع ما هو إلا ممارسة وتدريب وتطبيق (ما ولدنا من بطون أمهاتنا وكنا نعرف كتابة الأكواد بل تعلمناها بمرور الوقت مع التدريب والممارسة) YasserKhalil ExcelLover -
نتيجة اجمالي بيانات من صفحات في صفحة حسب الفترة
ياسر خليل أبو البراء replied to حسين مامون's topic in منتدى الاكسيل Excel
تمام الله ينور عليك أخي العزيز حسين الحمد لله الذي بنعمته تتم الصالحات والتعديل على الكود سيكسبك خبرة أكثر ومع الوقت ستتمكن من كتابة الأكواد بنفسك تقبل تحياتي -
جزيت خيراً أخي الكريم ناصر بمثل ما دعوت لي قمت منذ ساعة تقريباً بتسجيل فيديو يوضح كيفية عمل إجراء عام والأمر مشابه إلى حد كبير للمطلوب
-
وجزيت خيراً أخي الكريم ناصر اطلعت على الملف ووجدت عدد كيبر من الموديولات .. أي موديول أو كود تريد تعديله .. وهذه الميزة يمكن إضافتها باستبدال الجزء المتغير بجزء ثابت يتم استخدامه بشكل دائم مثال: لو أن لديك النطاق A1:B6 ومستخدم في الكود أكثر من مرة فيمكن ببساطة وضع سطر بهذا الشكل في بداية الكود Const strRange As String="A1:B6" ثم استخدم المتغير المسمى strRange (يمكن تسميته بما شئت ..) يمكن استخدامه في أي سطر موجود فيه النطاق على سبيل المثال : Sheets("Sheet1").Range("A1:B6").ClearContents سيكون بهذا الشكل بعد إضافة السطر الأول Sheets("Sheet1").Range(strRange).ClearContents لاحظ أنه تم استبدال النطاق A1:B6 بالمتغير الثابت وهكذا لأي متغير لديك ...
-
نتيجة اجمالي بيانات من صفحات في صفحة حسب الفترة
ياسر خليل أبو البراء replied to حسين مامون's topic in منتدى الاكسيل Excel
وعليكم السلام أخي الكريم حسين الكود بهذا الشكل مع الملف الجديد لا أعتقد أنه صحيح إذ يلزم أن تكون الأعمدة المساعدة بعيدة عن مجال البيانات .. قم بالتعديل وتجربة الكود وانظر هل النتائج صحيحة أم لا؟ حاول تدرس الكود وتفهم الأسطر المكتوبة لتستطيع أن تعدل عليه ، وإذا واجهك سطر غير واضح أخبرنا وسنقوم بشرحه إن شاء العلي القدير -
وجزيت خيراً بمثل ما دعوت لي أخي الكريم والحمد لله أن تم المطلوب على خير .. وأي كود قابل للتعديل والتطويع بما يتناسب مع الملف الأصلي بشرط فهم الكود وفهم كيفية التعديل عليه تقبل تحياتي
-
برنامج صلاحيات المستخدمين - بشكل جديد
ياسر خليل أبو البراء replied to إبراهيم محمد's topic in منتدى الاكسيل Excel
السبب هو استخدامك لنسخة 64 بت مما يزمه تغيير في أسطر الإعلان التي تظهر باللون الأحمر يمكن لأحد الأخوة ممن ييستخدمون 64بت أن يقوم بالتعديل ويجرب ثم يعيطك الملف بعد التعديل -
نتيجة اجمالي بيانات من صفحات في صفحة حسب الفترة
ياسر خليل أبو البراء replied to حسين مامون's topic in منتدى الاكسيل Excel
وعليكم السلام أخي الكريم حسين بارك الله فيك ومشكور على كلماتك الطيبة الكود بسيط جداً وليس معقد كما تعتقد .. فكرة الكود عمل حلقة تكرارية لأوراق العمل داخل المصنف (وقد قدمت فيديو لذلك) ، مع استثناء أوراق عمل معينة وقد أشرت إلى تلك النقطة في مشاركة سابقة حيث يوضع الشرط بعد بداية الحلقة وقبل نهاية الحلقة .. وما بين أسطر الحلقات يتم نسخ البيانات في أعمدة مساعدة تحددها بنفسك ففي المثال الأصلى استخدمت العمود I إلى M يمكن استخدام أي أعمدة بعيدة عن البيانات ... حدد السطر التالي Application.CutCopyMode = False ثم اضغط F9 من لوحة المفاتيح ونفذ الكود لهذا السطر فقط .. ستجد أن البيانات تم نسخها من أوراق العمل المختلفة إلى العمود رقم 9 .. قم بتغيير الرقم 9 إلى أي رقم عمود آخر Feuil1.Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial xlPasteValues هذا فقط للتوضيح وسيلزم تغييرات أخرى في الأسطر اللاحقة من الكود ولكن أحببت أن أوضح لك البداية لكي تفهم ما يجري بعد ذلك تم الاعتماد على الأعمدة المساعدة في تحقيق المطلوب من خلال معادلات Sumproduct أرجو ان يفي الشرح بالغرض إن شاء الله -
السلام عليكم أخي الكريم ناصر ابحث عن الإجراء الفرعي المسمى Sub Kh_JJJ(Nd As String) وعدل السطر التالي If .Cells(R, 1) = Nd Then ليكون بالشكل التالي If .Cells(R, 1) Like "*" & Nd & "*" Then
-
نتيجة اجمالي بيانات من صفحات في صفحة حسب الفترة
ياسر خليل أبو البراء replied to حسين مامون's topic in منتدى الاكسيل Excel
جرب الكود بالشكل التالي Option Explicit Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim rngDates As Range Dim rngTotal As Range Dim rngFine As Range Application.ScreenUpdating = False Set sh = Feuil1 For Each ws In ThisWorkbook.Worksheets If ws.Name <> "الرئيسية" And ws.Name <> "namodaj" And ws.Name <> "طباعة" Then If ws.Name <> sh.Name Then If ws.Range("B9").Value <> "" Then ws.Range("B9:F" & ws.Cells(Rows.Count, 2).End(xlUp).Row).Copy Feuil1.Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial xlPasteValues End If End If End If Next ws Application.CutCopyMode = False If sh.Range("I2").Value = "" Then Exit Sub Set rngDates = sh.Range("I2:I" & sh.Range("I2").CurrentRegion.Rows.Count + 1) Set rngTotal = sh.Range("J2:J" & sh.Range("J2").CurrentRegion.Rows.Count + 1) Set rngFine = sh.Range("M2:M" & sh.Range("J2").CurrentRegion.Rows.Count + 1) With sh.Range("E4:E" & sh.Cells(Rows.Count, 4).End(xlUp).Row) .Formula = "=SUMPRODUCT(--(MONTH(" & rngDates.Address & ")=MONTH(D4))*(YEAR(" & rngDates.Address & ")=YEAR(D4)),--(" & rngTotal.Address & "))" .Offset(, 1).Formula = "=SUMPRODUCT(--(MONTH(" & rngDates.Address & ")=MONTH(D4))*(YEAR(" & rngDates.Address & ")=YEAR(D4)),--(" & rngFine.Address & "))" .Offset(, 2).Formula = "=SUM(E4:F4)" .Resize(, 2).Value = .Resize(, 2).Value End With sh.Columns("I:M").ClearContents Application.Goto sh.Range("A1") Application.ScreenUpdating = True End Sub -
نتيجة اجمالي بيانات من صفحات في صفحة حسب الفترة
ياسر خليل أبو البراء replied to حسين مامون's topic in منتدى الاكسيل Excel
وعليكم السلام إذا أردت عمل استثناء لأوراق عمل معينة قم بإضافة سطر بعد سطر الحلقة التكرارية شبيه بما قدمه أخونا زيزو العجوز If sh.Name <> "الرئيسية" And sh.Name <> "namodaj" And sh.Name <> "طباعة" Then ولا تنسى الجملة End IF قبل نهاية الحلقة التكرارية -
جرب الكود التالي Sub SortColumnsByColorCount() Dim iCol As Long Dim firstRow As Long Dim lastRow As Long Dim i As Long Dim x As Long Application.ScreenUpdating = False firstRow = 3 lastRow = Range("B" & firstRow).CurrentRegion.Rows.Count + firstRow - 1 For iCol = 2 To 6 Cells(lastRow + 1, iCol).Value = ColorFunction(Range(Cells(3, iCol), Cells(lastRow, iCol))) Next iCol Range("B" & firstRow & ":F" & lastRow + 1).Sort Key1:=Range("B" & lastRow + 1), Header:=xlNo, Orientation:=xlLeftToRight Range("B" & lastRow + 1 & ":F" & lastRow + 1).ClearContents Application.ScreenUpdating = True End Sub Function ColorFunction(rRange As Range) Dim rCell As Range Dim vResult As Long For Each rCell In rRange If rCell.Interior.ColorIndex <> -4142 Then vResult = vResult + 1 End If Next rCell ColorFunction = vResult End Function
-
وعليكم السلام جرب المعادلة =IF($A2="","",IF(ROUND((SUM($C$1)-(($A2*18.5%)+SUM($B2)*10%)),2)<0,0,ROUND((SUM($C$1)-(($A2*18.5%)+SUM($B2)*10%)),2)))
-
يمكن نسخ النتائج ووضعها في مكان البيانات الأصلية بسطر آخر يقوم بعملية النسخ ثم حذف الصفوف المساعدة
-
وعليكم السلام جرب الكود التالي Sub SortColumnsByColorCount() Dim arr() As Variant Dim iCol As Long Dim firstRow As Long Dim lastRow As Long Dim i As Long Dim x As Long Application.ScreenUpdating = False firstRow = 3 lastRow = Range("B" & firstRow).CurrentRegion.Rows.Count + firstRow - 1 For iCol = 2 To 6 ReDim Preserve arr(iCol - 2) arr(UBound(arr)) = Val(ColorFunction(Range(Cells(3, iCol), Cells(lastRow, iCol))) & "." & iCol) Next iCol Call BubbleSort(arr()) For i = LBound(arr) To UBound(arr) x = Val(Split(CStr(arr(i)), ".")(1)) Range(Cells(3, x), Cells(lastRow, x)).Copy Cells(3, iCol + 2) iCol = iCol + 1 Next i Application.ScreenUpdating = True End Sub Function ColorFunction(rRange As Range) Dim rCell As Range Dim vResult As Long For Each rCell In rRange If rCell.Interior.ColorIndex <> -4142 Then vResult = vResult + 1 End If Next rCell ColorFunction = vResult End Function Sub BubbleSort(list()) Dim first As Long Dim last As Long Dim i As Long Dim j As Long Dim temp As Double first = LBound(list) last = UBound(list) For i = first To last - 1 For j = i + 1 To last If list(i) > list(j) Then temp = list(j) list(j) = list(i) list(i) = temp End If Next j Next i End Sub
-
نتيجة اجمالي بيانات من صفحات في صفحة حسب الفترة
ياسر خليل أبو البراء replied to حسين مامون's topic in منتدى الاكسيل Excel
وعليكم السلام جرب الكود التالي Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim rngDates As Range Dim rngTotal As Range Application.ScreenUpdating = False Set sh = Feuil1 For Each ws In ThisWorkbook.Worksheets If ws.Name <> sh.Name Then If ws.Range("B9").Value <> "" Then ws.Range("B9:E" & ws.Cells(Rows.Count, 2).End(xlUp).Row).Copy Feuil1.Cells(Rows.Count, 9).End(xlUp).Offset(1).PasteSpecial xlPasteValues End If End If Next ws Application.CutCopyMode = False If sh.Range("I2").Value = "" Then Exit Sub Set rngDates = sh.Range("I2:I" & sh.Range("I2").CurrentRegion.Rows.Count + 1) Set rngTotal = sh.Range("J2:J" & sh.Range("J2").CurrentRegion.Rows.Count + 1) With sh.Range("E4:E" & sh.Cells(Rows.Count, 4).End(xlUp).Row) .Formula = "=SUMPRODUCT(--(MONTH(" & rngDates.Address & ")=MONTH(D4))*(YEAR(" & rngDates.Address & ")=YEAR(D4)),--(" & rngTotal.Address & "))" .Value = .Value End With sh.Columns("I:J").ClearContents Application.Goto sh.Range("A1") Application.ScreenUpdating = True End Sub -
ماذا لو كان طول النص 17 ؟ ماذا لو كان طول النص 18؟ ماذا لو كان طول النص 19؟ ماذا لو كان طول النص 20؟ وسؤال : ما الغرض من تقسيم النص بهذه الطريقة؟ مجرد فضول
-
تحويل الاكسل الى ملف تنفيذي (EXE)
ياسر خليل أبو البراء replied to محمد يحياوي's topic in منتدى الاكسيل Excel
أخي الكريم أول مشاركة وتسأل عن الخبراء قم بطرح طلبك أو مشكلتك في موضوع جديد مع إرفاق ملف معبر عن المشكلة وضع بعض النتائج المتوقعة وهنا لن تجد خبراء بقدر ما ستجد أخوة سيحاولون تقديم ما أمكنهم من مساعدة -
اطلعت على الملف ولم أفهم المطلوب يرجى تحديد ورقة العمل المراد العمل عليها ، ثم ضع تفاصيل كاملة للطلب مع بعض النتائج المتوقعة حيث أنه لن أتمكن من التخمين ...
-
ضع ملف مرفق ليساعدك الأخوة بالمنتدى
-
أعتذر إليك حيث أنني لا أجد الوقت الكافي ، وأرجو من أحد الأخوة الأفاضل الإطلاع على الكود والتعديل عليه بما يتناسب مع طلب الأخ السائل تقبل اعتذاري
-
سؤال هل يمكن تجميع الخلايا الملونه
ياسر خليل أبو البراء replied to alaaaltwel's topic in منتدى الاكسيل Excel
يمكن إضافة هذا السطر في حدث تغير ورقة العمل Private Sub Worksheet_Change(ByVal Target As Range) Application.CalculateFull End Sub أو من لوحة المفاتيح Ctrl + Shift + F9 -
وعليكم السلام إن شاء الله غداً إذا تيسر لي الأمر سأحاول العمل على موضوعك إلا إذا تدخل أحد الأخوة الكرام بالمنتدى تقبل تحياتي
-
سؤال هل يمكن تجميع الخلايا الملونه
ياسر خليل أبو البراء replied to alaaaltwel's topic in منتدى الاكسيل Excel
السلام عليكم اطلع على الرابط التالي فيه ما تريد إن شاء الله من هنا