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

تفضل فقط نكرر الأمر عند حدث مفتاح السهم serch2.rar

شكراً وجزاك الله خيراً هذا بالضبط ألذي اردته

أخي الكريم من غير مرفق قد يواجه من يحاول مساعدتك مشاكل في تصور وتخيل اسماء الحقول والجداول ...... الخ فمثلاً ، ما هو ( delete account_no ) على العموم جرب هذا التعديل ، و أخبرني بالنتيجة Private Sub btnDeleteAccount_Click() Dim accountNo As String accountNo = Forms![chart_of_account]![account_no] If DCount("account_no", "entery_tbl", "[account_no]='" & accountNo & "'") = 0 Then DoCmd.RunSQL "DELETE FROM [chart_of_account] WHERE [account_no]='" & accountNo & "'" MsgBox "تم حذف الحساب بنجاح." Else Docmd.CancelEvent MsgBox "لا يمكن حذف الحساب لوجود حركة عليه." End If End Sub

على العموم الحمد لله انك لقيتي الحل . وفي المرات القادمة حاولي إرسال مرفق أختنا الكريمة حتى يتضح للمشاركين المشكلة وإيجاد الحل المناسب

اين هو المرفق يا صديقي خلاص لقيته ، تفضل مادة مكررة.accdb

يرجى التكرم تطبيق على البرنامج المرفق Datab (officena).accdb

جميل جدا المعلم والخبير الاستاذ فادي , اشكرك ياصديقي @Foksh 🌹

هذا مرفق كنت عملته للبحث عن الأخطاء وسببها .. باللغة العربية AccessAndJetErrorsاخطاء اكسس بحث.rar

تمام 100 % عاشت الايادي وزادتك الله تسلم

السطر الذي تشير إليه يقوم ب لاستخدام الكائن Dictionary. يمكنك فعل ذلك من خلال اتباع الخطوات التالية: 1. في محرر VBA، انتقل إلى القائمة "Tools" ثم "References" (أو "Tools" ثم "References" في Excel 2010). 2. ابحث عن "Microsoft Scripting Runtime" في القائمة. 3. حدد المربع بجانب "Microsoft Scripting Runtime". 4. انقر فوق "OK" لحفظ التغييرات.

تفضل أستاذ @Abdelaziz Osman الشرح .

تفضل استاذ @zan pc المرفق بعد التعديل وزيادة . test1 (111).rar

تفضل أستاذ @hayitham fathy المرفق بعد التعديل حسب مافهمت . بوليصة الشحن-1.rar

آمين وإياكم

شغال بامتياز هذا ما أريد بالضبط أستاذنا الكبير @ابوخليل بارك الله فيك وجعلها في ميزان حساناتك و رزقك من حيث لا تحتسب ويسر أمورك - آميـــــن- إن شاء الله صدقة جارية لك كما أشكر الأخ الكريم @Foksh على تفاعله مع الموضوع

جرب Sub ProcessData() Dim ws1 As Worksheet, ws2 As Worksheet Dim lastRow As Long, i As Long Dim officeName As String, dateValue As String, claimNumber As String Dim uniqueOffices As New Collection Dim officeDates As New Dictionary Dim officeClaims As New Dictionary ' Set references to the worksheets Set ws1 = ThisWorkbook.Sheets("Sheet1") ' Change "Sheet1" to the actual name of your worksheet Set ws2 = ThisWorkbook.Sheets("Sheet2") ' Change "Sheet2" to the actual name of your worksheet ' Find the last row in worksheet 1 lastRow = ws1.Cells(ws1.Rows.Count, "O").End(xlUp).Row ' Loop through the data in worksheet 1 For i = 1 To lastRow ' Get the office name officeName = ws1.Cells(i, "O").Value ' Add the office name to the uniqueOffices collection On Error Resume Next uniqueOffices.Add officeName, CStr(officeName) On Error GoTo 0 ' Get the date value dateValue = CStr(ws1.Cells(i, "P").Value) ' Get the claim number claimNumber = CStr(ws1.Cells(i, "Q").Value) ' Add the date and claim number to the dictionaries if they don't already exist If Not officeDates.Exists(officeName) Then officeDates.Add officeName, dateValue officeClaims.Add officeName, claimNumber ElseIf InStr(1, officeDates(officeName), dateValue) = 0 Then officeDates(officeName) = officeDates(officeName) & " + " & dateValue ElseIf InStr(1, officeClaims(officeName), claimNumber) = 0 Then officeClaims(officeName) = officeClaims(officeName) & " + " & claimNumber End If Next i ' Write the unique office names to worksheet 2 Dim office As Variant Dim rowIndex As Long: rowIndex = 1 For Each office In uniqueOffices ws2.Cells(rowIndex, 1).Value = office ' Write the dates for each office ws2.Cells(rowIndex, 2).Value = officeDates(office) ' Write the claim numbers for each office ws2.Cells(rowIndex, 3).Value = officeClaims(office) rowIndex = rowIndex + 1 Next office MsgBox "Process complete." End Sub يرجى تغيير اسمي الورقتين "Sheet1" و "Sheet2" إلى الأسماء الفعلية للورقتين الخاصتين بك.

جزاكم الله خيراً تسلم ايديك والشكر موصول للأستاذ أبو إيمان

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

ما فهمت منك لحد الساعة هو انك تريد فلترة ونسخ الصفوف مع الارتباط من ورقة Data الى الورقة النشطة تلقائيا بشرط وجود اسم الورقة في الخلية G2 ادا كان هدا هو طلبك ضع اولا الصيغة التالية في الخلية G2 على جميع الاوراق المرغوب نسخ البيانات عليها للتاكد من مطابقة الاسم يمكنك حدفها بعد دالك =MID(@CELL("filename";A1);FIND("]";@CELL("filename";A1))+1;31) وفي حدث Private Sub Worksheet_Activate ضع الكود التالي Private Sub Worksheet_Activate() Dim lRow2 As Long Set WS = Sheets("data"): Set dest = ActiveSheet If WS.AutoFilterMode Then WS.AutoFilterMode = False lRow2 = WS.Range("A" & Rows.Count).End(xlUp).Row Application.ScreenUpdating = False On Error Resume Next If dest.[G2].Value = dest.Name Then With WS.Range("A2:E" & lRow2) .AutoFilter Field:=5, Criteria1:=dest.[G2].Value Set Rng = WS.Range("A2:E" & lRow2).SpecialCells(xlCellTypeVisible) If Rng.Cells.Count > 1 Then With dest.Range("A2:F" & Rows.Count) .ClearContents: .Interior.ColorIndex = 0: .Borders.LineStyle = xlNone End With Rng.Copy dest.Range("A1") End If .AutoFilter End With End If On Error GoTo 0 End Sub TEST V2.xlsm

تفضل ccc2.rar