بحث مخصص من جوجل فى أوفيسنا
![]()
Custom Search
|
نجوم المشاركات
Popular Content
Showing content with the highest reputation on 08/11/23 in all areas
-
بسم الله الرحمن الرحيم السلام عليكم ورحمه الله وبركاته اساتذتي واخوتى هذا الملف به فهرس لجميع المنتدي ليسهل البحث للاعضاء يوجد فورم يمكنك البحث بها كما يمكنكم استخدام الفلتر العادي وبمجرد الضغط على اي نتيجه من نتائج البحث يتم فتح صفحتها في المنتدي ولا انسي فضل استاذي الكبير ياسر خليل على المساعده في عمل الملف تم تحديث الملف يوم الخميس الموافق 10 - 04 - 2025 فهرس منتدي الاكسيل.xlsb4 points
-
2 points
-
وعليكم السلام ورحمة الله وبركاته بعيدا عن التعقيد وتكرار البيانات عملت لك فلتر في ورقة البيانات وبعد تعديل البيانات تضغط زر حفظ التعديل فيلتغي الفلتر وبالتالي النتيجة واحدة أرجو أن يؤدي المطلوب هذي كل الأكواد Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("B1")) Is Nothing Then Range("A2:APL2").AutoFilter Field:=21, Criteria1:=Range("B1") End If End Sub Sub e() Range("A2:APL2").AutoFilter Field:=21 End Sub نسخ البيانات - الى الرئيسية .xlsb2 points
-
بارك الله فيك أخي العزيز حسونة وجزاك الله خيراً على كل ما تقدمه لإخوانك بالمنتدى2 points
-
1 point
-
الأخ الأستاذ القدير والرائع/أبو احمد انت مبدع ورائع فعلا فكما قلت لتكرار البيانات وتفي بالغرض الذي أنشده لك مني خالص الشكر والتقدير والاحترام وأسأل الله تعالى أن يحفظك من كل مكروه وأن يبارك لك في اولادك وعلمك ويعطيك الصحة والعافية والتوفيق والسداد إنه سميع مجيب وتحياتي1 point
-
1 point
-
1 point
-
نبحث عن العمل السهل اليسير .. بعيدا عن كثرة الاستعلامات او الاكواد والوحدات النمطية لا بد ان تجعل احد الحقلين ثابت وارى ان حقل الوصف اقرب للثبات حتى لو بلغ 10 صمم تقريرك بشكل افقي .. ويكون الوصف في الأعلى والمجاميع الكلية في الأسفل1 point
-
تفضل Private Sub CommandButton1_Click() Dim ws1, ws2, ws3 As Worksheet Dim lastRow, i, RowM2, RowM3 As Long Set ws1 = ThisWorkbook.Sheets("بيانات") Set ws2 = ThisWorkbook.Sheets("حرر") Set ws3 = ThisWorkbook.Sheets("لم يحرر") RowM2 = 8: RowM3 = 8 ws2.Range("A8:D1000") = "" ws3.Range("A8:D1000") = "" lastRow = ws1.Cells(ws1.Rows.Count, "B").End(xlUp).Row For i = 8 To lastRow If ws1.Cells(i, 5).Value = "حرر" Then ws2.Range("A" & RowM2 & ":D" & RowM2).Value = ws1.Range("A" & i & ":D" & i).Value RowM2 = RowM2 + 1 Else ws3.Range("A" & RowM3 & ":D" & RowM3).Value = ws1.Range("A" & i & ":D" & i).Value RowM3 = RowM3 + 1 End If Next i End Sub1 point
-
جميل جدا أخي الفاضل @حسونة حسين هذا العمل إبداع وهذه مساهمتي للبحث في موضوعات منتدى الاكسل ولكن في مجال الويب حتى يمكن البحث بسرعة بمجرد الكتابة ولو في الموبايل بدون الحاجة إلى برنامج الأوفيس https://officena.net/team/mas/excel.html بالتوفيق للجميع دعواتكم1 point
-
1 point
-
وجزاكم مثله ابو عبدالرحمن @علي بطيخ سالم وفيك بارك استاذنا الغالي @ياسر خليل أبو البراء تشرفت بمروركم الكريم1 point
-
1 point
-
اخي @الموسطي هذا الطلب غير طلبك في المشاركه الاولي بهذا الموضوع يرجي فتح موضوع جديد بالطلب الجديد1 point
-
هذا الموضوع تمت معالجته قبل ذلك كثيرا وبقليل من البحث كنت ستصل لضالتك ورغم أن الملف لا يوجد به أي محاولة من حضرتك وهذا يعني أنك تريد أن يعمل غيرك لصالحك وليس الهدف التعلم كما هو هدفنا في المنتدى رغم كل ما سبق هذا جهدي المتواضع في ملفك بالتوفيق إنشاء شيتات وربطها بالرئيسية.xlsb1 point
-
1 point
-
1 point
-
1 point
-
من روائع اعمال المحترم استاذ سليم حاصبيا في فلتره البيانات الى اي عدد من الشروط (المعايير ) جزاه الله عنا كل خير وبارك فيه يارب Option Explicit Sub transfer_data() 'هذا الكود للمحترم سليم حاصبيا 'الهدف من الكود هو فلتره البيانات 'وترحيلها الى صفحات 'تم هذا الكود في 6/12/2007 '==================== Dim My_Rg As Range Dim S_sh As Worksheet, My_Sheet As Worksheet Dim i As Byte '====== 'عدد صفحات الملف كاملا او اكثر Dim arr(1 To 44) '====== With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With '====== 'عدد الصفحات المطلوب الترحيل اليها+ صفحة المصدر For i = 2 To 7 '====== arr(i - 1) = Sheets(i).Name Next 'اسم صفحه المصدر Set S_sh = Sheets("المصدر") 'بدايه النطاق المطلوب فلترته Set My_Rg = S_sh.Range("A14").CurrentRegion If S_sh.AutoFilterMode = False Then My_Rg.AutoFilter End If '====== 'عدد الصفحات المطلوب الترحيل اليها For i = 1 To 6 '====== Set My_Sheet = Sheets(arr(i)) 'نطاق المسح في صفحات الهدف My_Sheet.Range("B4:F500").Clear 'رقم عمود الفلتره My_Rg.AutoFilter field:=4, Criteria1:=arr(i) 'بدايه خليه النسخ في صفحات الهدف My_Rg.SpecialCells(12).Copy My_Sheet.Range("B4") My_Rg.AutoFilter Next With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With 'كي لا تبقى شيء في الذاكرة يثقلها Erase arr Set S_sh = Nothing: Set My_Sheet = Nothing: Set My_Rg = Nothing: i = 0 End Sub ====== الفكره بالرغم من بساطتها رائعه ... ترك صفين تحت الرؤوس المدمجه ... الصف الاول الذي تركناه ... يكون فاضي والصف اللي تحته يكون فيه اسماء العناوين بدون دمج حفظك الله ورعاك يا استاذ سليم ======== الفلتره للمحترم سليم حاصبيا1.rar1 point
-
جزاك الله كل خير وبارك فيك استاذ / ahmedkamelelsayed0 الكود في ابهى حلته مع شرح الاسطر المطلوبه بارك الله في كل من كانت له بصمه في هذا العمل Option Explicit Sub transfer_data() 'هذا الكود للمحترم سليم حاصبيا 'الهدف من الكود هو فلتره البيانات 'وترحيلها الى صفحات 'تم هذا الكود في 6/12/2007 '==================== Dim My_Rg As Range Dim S_sh As Worksheet, My_Sheet As Worksheet Dim i As Byte '====== 'عدد صفحات الملف كاملا او اكثر Dim arr(1 To 44) '====== With Application .ScreenUpdating = False .Calculation = xlCalculationManual End With '====== 'عدد الصفحات المطلوب الترحيل اليها+ صفحة المصدر For i = 2 To 7 '====== arr(i - 1) = Sheets(i).Name Next 'اسم صفحه المصدر Set S_sh = Sheets("المصدر") 'بدايه النطاق المطلوب فلترته Set My_Rg = S_sh.Range("A14").CurrentRegion If S_sh.AutoFilterMode = False Then My_Rg.AutoFilter End If '====== 'عدد الصفحات المطلوب الترحيل اليها For i = 1 To 6 '====== Set My_Sheet = Sheets(arr(i)) 'نطاق المسح في صفحات الهدف My_Sheet.Range("B4:F500").Clear 'رقم عمود الفلتره My_Rg.AutoFilter field:=4, Criteria1:=arr(i) 'بدايه خليه النسخ في صفحات الهدف My_Rg.SpecialCells(12).Copy My_Sheet.Range("B4") My_Rg.AutoFilter Next With Application .ScreenUpdating = True .Calculation = xlCalculationAutomatic End With Erase arr Set S_sh = Nothing: Set My_Sheet = Nothing: Set My_Rg = Nothing: i = 0 End Sub1 point
-
1 point
-
1 point
-
الأستاذ / booss السلام عليكم ورحمة الله وبركاته إليك الملف به المطلوب. list1.rar1 point
-
استاذ مختار لتنفيذ رغبتك عليك تعديل الكود ليصبح كما يلي: Sub hide_secret() Application.CommandBars("Column").Enabled = False Columns("k:k,n:n,p:p").EntireColumn.Hidden = True If [i1].Value = 123 Then Columns("k:k,n:n,p:p").EntireColumn.Hidden = False End If [i1] = 0 End Sub1 point
-
1 point