نجوم المشاركات

المرجوا من مشرفي المنتدى ترك صلاحية اختيار افضل اجابة لصاحب الطلب كما هو معمول به في اكبر المنتديات لانني انا مشترك في اكثر المواقع شهرة وللاسف الاحظ هدا الامر هنا فقط وهدا يتكرر اكثر من مرة طرف المشرفين دون ان يقوم اصلا صاحب الطلب بتحميل المرفق نحن هنا لا ناخد اجرا على مساعدت الناس يكفينا دعوة في ظهر الغيب هكدا سوف نفقد الثقة في مصداقية المنتدى وربما ننسحب منه المرجوا اخد الامر بجدية من فضلكم و الاشتغال بحرفية . لتعم الفائدة على الجميع وشكرا لكم وهدا مثال للاعجاب واظافة افضل اجابة وصاحب الطلب لم يرى الاجابة اصلا 😄

مرحبا اساتذتنا الكرام يسرني المشاركة معكم في ايجاد حل للمطلوب رغم انني لم استوعب الفكرة جيدا وكنت قد صرفت النظر عن المشاركة في الموضوع لاكن بعد معاينة النتيجة المستخرجة على ملف الاستاد @AbuuAhmed الدي نكن له كل الاحترام والتقدير. اليك اخي هده المساهمة البسيطة على قدر ما استطعت فهمه لحد الساعة مع تغيير اسم الورقة المظافة من مصفوفة الى Test 🫣🫣 Sub test1() Dim wb As Workbook, WSdata As Worksheet, dest As Worksheet, lRow As Long, lCol As Long Set wb = ThisWorkbook: Set WSdata = wb.Sheets("الفواتير"): Set dest = wb.Sheets("Test") A = WSdata.Range("A2:I" & WSdata.[D65000].End(xlUp).Row) With Application .ScreenUpdating = False With dest Intersect(.Range(.Rows(2), .UsedRange.Rows(.UsedRange.Rows.Count)), .Range("A:I")).ClearContents End With Dim c(): ReDim c(1 To UBound(A, 1), 1 To 9) Cpt = 0 Set mondico = CreateObject("Scripting.Dictionary") For I = 1 To UBound(A) On Error Resume Next clé = A(I, 4) & A(I, 8) If Not mondico.exists(clé) Then Cpt = Cpt + 1: mondico.Add clé, Cpt: c(Cpt, 1) = clé: F = Cpt Else F = mondico.Item(clé) End If c(F, 1) = A(I, 1): c(F, 2) = A(I, 2): c(F, 3) = A(I, 3): c(F, 4) = A(I, 4): c(F, 5) = c(F, 5) + A(I, 5) c(F, 6) = c(F, 6) + A(I, 6): c(F, 7) = c(F, 7) + A(I, 7): c(F, 8) = A(I, 8): c(F, 9) = A(I, 9) Next dest.[a3].Resize(mondico.Count, UBound(c, 2)) = c lRow = dest.Cells.Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row With dest Union(dest.Range("A3:A" & lRow), dest.Range("F3:F" & lRow)).NumberFormat = "#,##0;- #,##0;""-""??" dest.Range("C3:C" & lRow).NumberFormat = "dddd dd-mm-yyyy" dest.Range("E3:E" & lRow).NumberFormat = "#,##0.0;- #,##0.0;""-""??" If dest.ListObjects.Count <> 0 Then Exit Sub lCol = .Cells(3, dest.Columns.Count).End(xlToLeft).Column dest.ListObjects.Add(xlSrcRange, .Range(dest.Cells(3, 1), .Cells(lRow, lCol)), , xlYes).Name = "Table1" .ListObjects("Table1").ShowAutoFilterDropDown = False End With On Error GoTo 0 .ScreenUpdating = True End With End Sub تجربة1.xlsb

عطني وقت لأن هكذا الموضوع تغير .

الباس (samer)؟؟؟ ,وأي فورم (vocations222) . تريد زر الاستدعاء أي جدول .؟؟

جرب المرفق اضطررت لعمل صفحة خاصة باسم "مصفوفة" تم حذف المرفق لوجود هفوة في هذين السطرين: tRow = 2 For row1 = 2 To lRow

أخي @سامر محمود تفضل محاولتي . ووافني بالرد . UbdaTable.rar

جزاك الله خير يا استاذ Foksh

@Foksh بارك الله فيك استاذى الكريم وجعل علمك فى ميزان حسناتك لو تعلم حل حضرتك ده انقذنى من عمل كبير جدا بشكل دورى

تفضل أخي @salah.sarea . لديك طريقتين للنسخ الإحتياطي لقاعدة البيانات المقسمة ، وتم انشاء كود جديد للإستعادة . بيانات.zip

تفضل محاولتي أخي الكريم @figo82eg . New Microsoft Access Database.accdb

تم التعديل بطريقة أخرى ,, Private Sub Text26_BeforeUpdate(Cancel As Integer) Dim inputValue As String Dim validCharacters As String Dim i As Integer validCharacters = "RAFBDIQ0123456789" inputValue = Nz(Me.Text26.Value, "") For i = 1 To Len(inputValue) If InStr(validCharacters, Mid(inputValue, i, 1)) = 0 Then MsgBox "ÅÏÎÇá ÍÑæÝ ÛíÑ ÕÍíÍ", vbExclamation, "Error" Cancel = True Exit Sub End If Next i End Sub حيث Text26 اسم مربع النص في نموذجك

شكرا أستاذ محمد تمام بارك الله فيك و جعله في ميزان حسناتك

خالص الشكر الخبير الافاضل Moosak

السلام عليكم للأسف هذه معلومة جديدة لي وهي سيئة جدا، وهذا عيب من عيوب الموقع. الآن تفهمت بعض الممارسات الخاطئة ومنها هذا الخيار، أساسا خيار "أفضل إجابة" يساء استخدامه من كثير من أعضاء المنتدى، وإعطاء هذه الخيار للمشرفين أكثر سوءًا. ولا تحدثنا أستاذ محمد عن تقوى المشرفين وفريق العمل وتحدثنا عن أخلاقهم العالية وتعاملهم الذي يضرب به الأمثال، فهم أناس مثلهم مثل باقي الأعضاء لهم ما لهم وعليهم ما عليهم، فمنهم من تحدث بينه وبين الأعضاء احتكاكات ومصادمات وتنافر تحيدهم عن الجادة والإنصاف والسلوك المسئول وربما يقومون بأخطاء مقصودة وموجهة أيضا. في هذا الموضوع: أفضل إجابة واضحة وضوح الشمس في عز الظهر لا تحتاج إلى جهد ولا إلى تفكير ولا إلى محكمين متمرسين ومع أني لست بحاجة لها ولكنها بكل بساطة سرقت مني وقدمت كهدية لغيري 🙂 وهذا به استفزاز كبير. شيء سيئ للغاية، وقد كنت أعتقد أن السائل هو من قام بالاختيار ولكن بعد حذف تعليقي والذي لا يحتوي على إهانات ولا استنقاص من أحد ولا لغة رديئة ومن ثم غلق الموضوع وبعد قراءتي لهذا الموضوع عرف السبب وبطل العجب. لما الخوف من إبداء الآراء وتقديم الملاحظات والانتقادات، هذا وإن أعضبتك مشاركتي فهذا سلوك غير الواثق والخائف. تحياتي.

وعليكم السلام تفضل: Book1.xlsx

السلام عليكم ورحمة الله وبركاته إن شاء الله يكون هذا هو المطلوب Copy of new.zip

ارسل مرفق أخي الكريم للعمل عليه 😊

وعليكم السلام ورحمه الله وبركاته تفضل اخي هانى Unique.xlsb

السلام عليكم ورحمة وبركاته من باب المساهمة ومساعدة من قد يستفيدوا من هذا المشروع ارفقه لكم وفي حال وجود اخطاء او نواقص تبخلوا علينا بذكرها stores.and.salesmen.rar