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

وعليكم السلام ورحمة الله وبركاته ،، جرب هذا التعديل على حسب ما فهمت من الشرح Sub Test_Optimized() Dim ws As Worksheet, dataArr As Variant, outputArr() As Variant Dim i As Long, ii As Long, p As Long, startRow As Long, endRow As Long Dim chunkSize As Long, chunkStart As Long, chunkEnd As Long Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Application.EnableEvents = False Set ws = ActiveSheet chunkSize = 5000 ReDim outputArr(1 To chunkSize * 10, 1 To 14) With ws .Columns("Q:P").Clear .Columns("P").ColumnWidth = 12 .Range("R1").Resize(, 14).Value = Array("الدفعة", "ج", "ت ح", "ت م", "ت ع", "ل ع", "ل ح", "ل م", "ل ع1", "ر ع1", "ل ح1", "ر ح1", "ل م", "ر م1") .Range("R1").Resize(, 14).Interior.Color = RGB(146, 205, 220) .Range("R1").Resize(, 14).HorizontalAlignment = xlCenter For chunkStart = 2 To 13000 Step chunkSize chunkEnd = chunkStart + chunkSize - 1 If chunkEnd > 13000 Then chunkEnd = 13000 dataArr = .Range("A" & chunkStart & ":N" & chunkEnd).Value p = 1 For i = LBound(dataArr, 1) To UBound(dataArr, 1) If IsNumeric(dataArr(i, 2)) And IsNumeric(dataArr(i, 3)) Then startRow = dataArr(i, 2) endRow = dataArr(i, 3) For ii = startRow To endRow outputArr(p, 1) = dataArr(i, 1) outputArr(p, 2) = ii outputArr(p, 3) = dataArr(i, 4) outputArr(p, 4) = dataArr(i, 5) outputArr(p, 5) = dataArr(i, 6) outputArr(p, 6) = dataArr(i, 7) outputArr(p, 7) = dataArr(i, 8) outputArr(p, 8) = dataArr(i, 9) outputArr(p, 9) = dataArr(i, 10) outputArr(p, 10) = dataArr(i, 11) outputArr(p, 11) = dataArr(i, 12) outputArr(p, 12) = dataArr(i, 13) outputArr(p, 13) = dataArr(i, 14) outputArr(p, 14) = dataArr(i, 14) p = p + 1 Next ii End If Next i If p > 1 Then .Range("R" & chunkStart).Resize(p - 1, 14).Value = outputArr ReDim outputArr(1 To chunkSize * 10, 1 To 14) End If Next chunkStart End With Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic Application.EnableEvents = True End Sub

السلام عليكم ورحمة الله وبركاته هذا تحديث بسيط ومهم في نفس الوقت على هذه الأداة الجميلة 🙂 ( عون المثابر في الحصول على أسماء العناصر (الإصدار 3.0)) كما علمتم هذه الأداة صممتها بفضل الله في أكسس تقوم بإحضار وسرد أسماء العناصر لك لكي تستطيع نسخها ولصقها في أي مكان تريد بكل سهولة ويسر 🙂 شخصيا أستفدت كثيرا منها وسهلت علي الكثير من الجهد وقلصت من وقت العمل بحمد الله وفضله. :: ما الجديد في النسخة 3.0 :: تم إضافة خانة في الأخير خاصة بالجداول فقط .. : وهي عند اختيار الجدول يتم كتابة جمل SQL أستعلامات أساسية للجدول المختار مع ذكر أسماء حقول الجدول مع مراعاة أنواع الحقول وكتابتها بشكل سليم في الكود .. طبعا الأداة ستعطيك الجمل الاستعلامية الأربعة SELECT, INSERT INTO, UPDATE ,DELETE والكود الناتج جاهز للصقه مباشرة في محرر الأكواد VBA .. عليك فقط أن تقوم ببعض التعديلات الطفيفة كإزالة الحقول الزائدة أو الغير مستهدفة وكذلك تحديد الشرط Where في حال التحديث أو الحذف مثلا . :: لقطة للنسخة 3.0 :: وهذا مثال على جمل ال SQL الناتجة : ' SELECT statement Dim sqlSelect As String sqlSelect = "SELECT [ID], [First Name], [Last Name], [Gender], [Age], [Email], [Phone], [Education], [Occupation], [Salary], [StaffNumber], [IsActive], [DOB]" sqlSelect = sqlSelect & vbCrLf & " FROM [SampleTable]" '============================================================ ' INSERT INTO statement Dim sqlInsert As String sqlInsert = "INSERT INTO [SampleTable] ([ID], [First Name], [Last Name], [Gender], [Age], [Email], [Phone], [Education], [Occupation], [Salary], [StaffNumber], [IsActive], [DOB])" sqlInsert = sqlInsert & vbCrLf & " VALUES (" & var_ID & ", '" & var_FirstName & "', '" & var_LastName & "', '" & var_Gender & "', " & var_Age & ", '" & var_Email & "', '" & var_Phone & "', '" & var_Education & "', '" & var_Occupation & "', " & var_Salary & ", " & var_StaffNumber & ", " & IIf(var_IsActive, -1, 0) & ", #" & var_DOB & "#)" '============================================================ ' UPDATE statement Dim sqlUpdate As String sqlUpdate = "UPDATE [SampleTable]" sqlUpdate = sqlUpdate & vbCrLf & " SET [ID] = " & var_ID & ", [First Name] = '" & var_FirstName & "', [Last Name] = '" & var_LastName & "', [Gender] = '" & var_Gender & "', [Age] = " & var_Age & ", [Email] = '" & var_Email & "', [Phone] = '" & var_Phone & "', [Education] = '" & var_Education & "', [Occupation] = '" & var_Occupation & "', [Salary] = " & var_Salary & ", [StaffNumber] = " & var_StaffNumber & ", [IsActive] = " & IIf(var_IsActive, -1, 0) & ", [DOB] = #" & var_DOB & "#" sqlUpdate = sqlUpdate & vbCrLf & " WHERE [SomeField] = SomeValue" '============================================================ ' DELETE statement Dim sqlDelete As String sqlDelete = "DELETE FROM [SampleTable]" sqlDelete = sqlDelete & vbCrLf & " WHERE [SomeField] = SomeValue" الشرح القديم للأداة على اليوتيوب 🙂 متابعة ممتعة 😊👌🏼 ولا أستغني عن آراءكم وملاحظاتكم .. 🙂 لتحميل الملف :

الغالي الاستاذ @Foksh دايما بشوف افكارك جديدة والله انت وباقي الزملاء الخبراء وبتعلم منها بشكرك علي كرم الرد والاستجابة وبحاول اعدل بعد اذنك حاجات بسيطة لتلبية احتياجات العمل الاستاذ الصديق المحترم الاخ @kkhalifa1960 بشكرك علي كرم الرد والمساعدة الغالية الثمينة والله ودايما بتكون اول انسان يمد ايد المساعدة

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

هذا هو المطلوب اخي الخبير Foksh وشكرا ليك على مساعدتك الكريمة في تعديل الاستعلام تعبت معايا وبرغم كده كنت دايما واسع الصدر وبترد بسرعة واهتمام كأن المشكلة بتاعتك ربنا يجازيك كل خير ويزيدك علم ونف، شكرا لحضرتك من قلبي على كل حاجة

أداة رائعة جدا .. شكرا لك

هل هذا ما تريده ؟ class_be1.accdb

السلام عليكم عاشت ايدك استاذ شكرأ جزيلاً

مشاركةً مع الزملاء الافاضل تفضل اسناذ @dd13901390 المطلوب حسب ما فهمت بالشرح والمرفق التالي . ووافني بالرد . dd13901390.rar

على افترض أن لدينا 100 معلم منهم 8 بلجنة التصحيح ولدينا 12 لجنة امتحان ولدينا 8 مواد بــ 8 ايام امتحانات اليكم التوزيع مع مراعاة العدالة في كل شئ ... واصدار تقريران الاول التوزيع حسب كل مادة امتحان كل مادة بصفحة .... والثاني للاحصائيات فقط اذهب لنهايته ستحصل على جدول بالاحصائيات .. ولكم مني كل الاحترام والتقدير . توزيع المراقبين على اللجان.rar

تم إضافة تحديث جديد للملف .. النسخة 1.7 🙂

أخى الحبيب / محمود المنتدى منور بأصحاب الأخلاق الفاضلة والذوق الرفيع والاحساس المرهف مثل أخى الحبيب محمود

نورت الدنيا كلها ياأستاذي

أخى الفاضل / jooohn جزاك الله كل خير أستاذى الحبيب / عبد الله باقشير أسعدك الله فى الدارين