بحث مخصص من جوجل فى أوفيسنا
Custom Search
|
-
Posts
13,165 -
تاريخ الانضمام
-
تاريخ اخر زياره
-
Days Won
412
نوع المحتوي
المنتدى
مكتبة الموقع
معرض الصور
المدونات
الوسائط المتعددة
كل منشورات العضو ياسر خليل أبو البراء
-
منع الادخال في الحضور والانصراف الا عن طريق دبل كليك
ياسر خليل أبو البراء replied to أبو قاسم's topic in منتدى الاكسيل Excel
وعليكم السلام جرب الكود التالي في حدث ورقة العمل Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target.Row > 8 Then If Target.Column = 8 Or Target.Column = 9 Or Target.Column = 10 Then Cancel = True Target.Value = Format(Time, "hh:mm") End If End If End Sub -
ترحيل وفرز الاصناف المكررة لعمل كارتة صنف
ياسر خليل أبو البراء replied to محمدحسني احمد's topic in منتدى الاكسيل Excel
بارك الله فيك أخي الغالي زيزو العجوز .. كود رائع واستخدام أروع للدالة CHOOSE في تحديد الأعمدة المطلوب ترحيلها .. جزاك الله خير الجزاء على كل ما تقدمه لإخوانك تقبل وافر تقديري واحترامي -
استدعاء اعمده معينه وبشرط النجاح
ياسر خليل أبو البراء replied to ناصر سعيد's topic in منتدى الاكسيل Excel
بارك الله فيك أخي العزيز ناصر وجزيت خيراً على كلماتك الطيبة تقبل وافر تقديري واحترامي -
وجزيت خيراً بمثل ما دعوت لي أخي الكريم تقبل تحياتي
-
السلام عليكم استخدم الدالة TRUNC بهذا الشكل =TRUNC(A1,2)
-
وعليكم السلام أخي الغالي خالد الرشيدي بارك الله فيك وجزاك الله خيراً على كلماتك الطيبة .. وجزيت خيراً بمثل ما دعوت لي وزيادة
-
جرب الكود التالي Sub Test() Dim r As Range For Each r In Range("D5:D" & Cells(Rows.Count, "D").End(xlUp).Row).SpecialCells(2, 1).Areas r(r.Count + 1).Formula = "=subtotal(9," & r.Address & ")" r(r.Count + 1).Offset(, 1).Formula = "=subtotal(9," & r.Offset(, 1).Address & ")" Next End Sub
-
وعليكم السلام ورحمة الله وبركاته تفضل أخي الكريم
-
بارك الله فيك أخي الحبيب عبد الله أخي الكريم الذول يمكنك استخدام الدالة MID لاستخراج العدد المطلوب من الأرقام .. ابحث عن الدالة وشرحها لتتعلم كيف تنفذ الأمر بنفسك فالأمر بسيط إن شاء الله
-
ارجو المساعدة عاجلاًً خطاء في كود
ياسر خليل أبو البراء replied to عبدالرحمن السويح's topic in منتدى الاكسيل Excel
الخطأ كان في هذا السطر بشكل خاص lrow = Range("d" & Rows.Count).End(xlUp) حيث يشير إلى نطاق والمطلوب أن يكون معبر عن رقم آخر صف لذا تمت إضافة الخاصية .Row وهي تجلب رقم آخر صف ... وبما أننا نريد وضع بيانات في صف جديد فتم إضافة الرقم 1 إذا أردت الإشارة لورقة عمل أخرى سيكون عليك أن تغير رقم فهرس الورقة من خلال السطر التالي Sheets(1).Activate -
ارجو المساعدة عاجلاًً خطاء في كود
ياسر خليل أبو البراء replied to عبدالرحمن السويح's topic in منتدى الاكسيل Excel
جرب التعديل التالي Private Sub CommandButton1_Click() Sheets(1).Activate lrow = Range("d" & Rows.Count).End(xlUp).Row + 1 Range("d" & lrow).Value = ComboBox1.Value Range("d" & lrow).Offset(0, 1).Value = TextBox1.Value Range("d" & lrow).Offset(0, 2).Value = TextBox2.Value Range("d" & lrow).Offset(0, 3).Value = TextBox3.Value Range("d" & lrow).Offset(0, 4).Value = TextBox4.Value Range("d" & lrow).Offset(0, 5).Value = TextBox5.Value Range("d" & lrow).Offset(0, 6).Value = TextBox6.Value ComboBox1.Value = "" TextBox1.Value = "" TextBox2.Value = "" TextBox3.Value = "" TextBox4.Value = "" TextBox5.Value = "" TextBox6.Value = "" End Sub -
وعليكم السلام جرب الكود التالي Sub Test() Dim ws As Worksheet Dim sh As Worksheet Dim arr As Variant Dim temp As Variant Dim i As Long Dim j As Long Dim c As Long Dim b As Boolean Dim t As Double Set ws = Sheets("السجل") Set sh = Sheets("وصل") arr = ws.Range("A4:J" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Value ReDim temp(1 To UBound(arr, 1), 1 To 4) sh.Range("A4:D" & Rows.Count).ClearContents For i = LBound(arr, 1) To UBound(arr, 1) If arr(i, 2) = sh.Range("A2").Value Then If b = False Then sh.Range("B2").Value = arr(i, 3) sh.Range("G4").Value = arr(i, 8) b = True End If j = j + 1 For c = 4 To 7 temp(j, c - 3) = arr(i, c) Next c t = Application.WorksheetFunction.Sum(t, arr(i, 9)) End If Next i If j > 0 Then sh.Range("F4").Value = t sh.Range("A4").Resize(j, UBound(temp, 2)).Value = temp End If End Sub
-
بارك الله فيك أستاذي الحبيب محمد صالح أخي الكريم زاكي شاهد الفيديو التالي لعله يفيدك في بعض الأساسيات https://youtu.be/59WvTJvdfOQ
-
السلام عليكم جرب الكود التالي Sub Test() Dim r As Long Dim c As Long Dim t As Variant Dim b As Boolean Application.ScreenUpdating = False For r = 2 To Cells(Rows.Count, 1).End(xlUp).Row b = False For c = 2 To 14 If Not IsEmpty(Cells(r, c)) Then t = Cells(r, c) Next c For c = 2 To 14 If Cells(r, c) <> t And Not IsEmpty(Cells(r, c)) Then b = True If b And Not IsEmpty(Cells(r, c)) Then Cells(r, 1).Interior.Color = vbCyan Cells(r, c).Interior.Color = vbGreen End If Next c Next r Application.ScreenUpdating = True End Sub
-
ارجو المساعدة عاجلاًً خطاء في كود
ياسر خليل أبو البراء replied to عبدالرحمن السويح's topic in منتدى الاكسيل Excel
أخي الكريم ارفق الملف نفسه وليس الفورم فقط .. حيث عند استيراد الفورم يحدث خطأ -
سؤال حول كيفية استخدام Sum If بشكل مختلف
ياسر خليل أبو البراء replied to عماد محى الدين's topic in منتدى الاكسيل Excel
تفضل أخي الكريم الكود في ملف مرفق .. Test.rar -
طلب كود او معادلة للترقيم التلقائي برقم الصفحة
ياسر خليل أبو البراء replied to mahmoudslah's topic in منتدى الاكسيل Excel
بارك الله فيك أخي الحبيب سليم اطلعت على الملف ووضعت الكود بناء على فهمته من الشرح وإن كان غير ذلك ننتظر رد الأخ السائل .. جزيت خيراً على الاهتمام بالموضوع .. تقبل وافر تقديري واحترامي -
طلب كود او معادلة للترقيم التلقائي برقم الصفحة
ياسر خليل أبو البراء replied to mahmoudslah's topic in منتدى الاكسيل Excel
ضع الكود التالي في حدث المصنف ... سيعمل الكود عند تنشبط ورقة العمل (جرب الانتقال لورقة أخرى وارجع لورقة العمل وسيعمل الكود) Private Sub Workbook_SheetActivate(ByVal Sh As Object) Sh.Range("F6").Value = Sh.Name End Sub -
سؤال عن كيفية ربط ثلاثة ملفات اكسل ؟
ياسر خليل أبو البراء replied to إسلام العزونى's topic in منتدى الاكسيل Excel
وعليكم السلام ورحمة الله وبركاته استخدم خاصية البحث والاستبدال واختر من النافذة الخاصة بذلك Workbook ليشمل البحث أوراق العمل كافة والتعديل سيكون على كافة نتائج البحث مرة واحدة اضغط Ctrl + H من لوحة المفاتيح .. -
سؤال حول كيفية استخدام Sum If بشكل مختلف
ياسر خليل أبو البراء replied to عماد محى الدين's topic in منتدى الاكسيل Excel
بارك الله فيك أخي الكريم نوري والحمد لله الذي بنعمته تتم الصالحات تقبل وافر تقديري واحترامي -
وعليكم السلام ورحمة الله وبركاته جرب التعديل التالي Sub UsingArrays() Dim arr As Variant Dim temp As Variant Dim lr As Long Dim i As Long Dim j As Long Dim c As Long Sheets("Sheet2").Range("E6:H1000").Clear lr = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row arr = Sheets("Sheet1").Range("A2:D" & lr).Value ReDim temp(1 To UBound(arr, 1), 1 To UBound(arr, 2)) j = 1 For i = LBound(arr, 1) To UBound(arr, 1) If arr(i, 4) = Range("K5") Then For c = LBound(arr, 2) To UBound(arr, 2) temp(j, c) = arr(i, c) Next c j = j + 1 End If Next i If j = 1 Then MsgBox "Invalid Criteria", vbExclamation: Exit Sub Sheets("Sheet2").Range("E5").Resize(, UBound(temp, 2)).Value = Array("الكود", "الأسماء", "الدرجات", "الحالة") Sheets("Sheet2").Range("E6").Resize(j - 1, UBound(temp, 2)).Value = temp End Sub
-
وعليكم السلام جرب الكود التالي Sub Test() Dim iRow As Long Dim iCol As Long Dim iCount As Long Application.ScreenUpdating = False For iRow = 2 To 20 Step 3 For iCol = 1 To 17 Step 2 Cells(iRow, iCol).Value = 100000 + iCount iCount = iCount + 1 Next iCol Next iRow Application.ScreenUpdating = True End Sub