علي السحيب

استخدم نفس الشرط الذي يتحقق به تلوين الأعمدة في إعطاء قيمة للخلية التي تريد،

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

شاهد المرفق، ___________________________________________.rar

المرفق يحتوي على برنامج لفك حماية أوراق العمل المحمية .. وخطوات استخدامه كالتالي: 1- أفتح الملف المحمي الذي لديك. 2- أفتح الملف الموجود في المرفقات وحينها سوف يتم إدراج بعض الخيارات في القائمة أدوات وهي كالتالي: - Unprotect Sheet .. وهي تعمل على فك حماية ورقة العمل. - Unprotect Wrokbook .. وهي تعمل على فك حماية المصنف. password.rar

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

هذا الأمر يستوجب عمل بعض التعديلات الطفيفة على الكود .. وهي فقط تغيير مجال وضع النتائج .. وبعد عمل ذلك يصبح الكود كالتالي: Sub Compare2() Sheet2.[B3:C65536,E3:F65536].ClearContents For R = 3 To 9 If Application.WorksheetFunction.CountIf(Sheet1.[E3:E9], Sheet1.Cells(R, 2)) = 0 Then With Sheet2.Columns(2).Rows(65536).End(xlUp) .Offset(1, 0) = Sheet1.Cells(R, 2) .Offset(1, 1) = Sheet1.Cells(R, 3) End With End If Next For R = 3 To 9 If Application.WorksheetFunction.CountIf(Sheet1.[B3:B9], Sheet1.Cells(R, 5)) = 0 Then With Sheet2.Columns(5).Rows(65536).End(xlUp) .Offset(1, 0) = Sheet1.Cells(R, 5) .Offset(1, 1) = Sheet1.Cells(R, 6) End With End If Next MsgBox "!أنتهت عملية المقارنة بين الجدولين بنجاح وتم وضع النتائج في الصفحة الثانية", vbInformation, "نتيجة المقارنة" End Sub شاهد المرفق، _______________________________.rar

هل تقصد أن يتم كتابة الصيغة نفسها داخل الخلية .. أو نتيجة الصيغة فقط. إذا كانت لديك صيغة جاهزة .. ضعها هنا .. وإن شاء الله نزودك بما تريد

خاصية العلامة الصفراء أو المساة Smart Tag غير موجودة في أوفيس 2000 .. لذا أنصح بإستخدام الطريقة التي ذكرها الأخ مجاهد وهي:

تتم المقارنة بين الجدولين عن طريق الكود التالي: Sub Compare() [B16:C65536,E16:F65536].ClearContents For R = 3 To 9 If Application.WorksheetFunction.CountIf([E3:E9], Cells(R, 2)) = 0 Then With Columns(2).Rows(65536).End(xlUp) .Offset(1, 0) = Cells(R, 2) .Offset(1, 1) = Cells(R, 3) End With End If Next For R = 3 To 9 If Application.WorksheetFunction.CountIf([B3:B9], Cells(R, 5)) = 0 Then With Columns(5).Rows(65536).End(xlUp) .Offset(1, 0) = Cells(R, 5) .Offset(1, 1) = Cells(R, 6) End With End If Next MsgBox "تمت المقارنة بين الجدولين بنجاح", vbInformation, "تمت المقارنة" End Sub شاهد المرفق، _______________________________.rar

أشكرك ..

أشكرك أخي الكريم،

شرح كيفية نقل الوحدة النمطقة من ملف إلى آخر موجود في بداية هذا الموضوع ..

الإجابة موجودة على الرابط التالي: http://www.officena.net/ib/index.php?showtopic=13948

لا تبالغ أخي الكريم .. فأنا مجرد تلميذ صغير في هذا المنتدى

أشكرك أخي تامر على مرورك ومشاركتك،

الكود التالي ينفذ جميع ما طلبت: Private Sub Worksheet_Change(ByVal Target As Range) MF = Application.WorksheetFunction.CountA([B1:E65535]) Mod 4 If [A1] = "" Then Exit Sub If Target.Address = "$A$1" Then With Columns(1).Rows(65536).End(xlUp) .Offset(Application.WorksheetFunction.CountA([E1:E65536]), MF + 1) = [A1] End With With [A1] .Select .ClearContents End With End If End Sub شاهد المرفق، __________________________________________.rar

شاهد المرفق والذي يحتوي على الكود التالي: Private Sub Worksheet_Change(ByVal Target As Range) TA = Target.Address If TA = "$AE$20" Or TA = "$AE$21" Then If [AE20] = 1 And [AE21] = 2 Then [C17] = 7 [C18] = 2 [C19] = 5 [C20] = 4 [B17] = 10 [B18] = 10 [B19] = 60 [B20] = 60 ElseIf [AE21] = 0 And [AE20] = 1 Then [C17] = 2 [C18] = 5 [C19] = 4 [C20] = "" [B17] = 10 [B18] = 60 [B19] = 60 [B20] = "" ElseIf [AE20] = 0 And [AE21] = 2 Then [C17] = 1 [C18] = 5 [C19] = 4 [C20] = "" [B17] = 10 [B18] = 60 [B19] = 60 [B20] = "" ElseIf [AE20] = 0 And [AE21] = 0 Then [C17] = "" [C18] = "" [C19] = "" [C20] = "" [B17] = "" [B18] = "" [B19] = "" [B20] = "" End If End If End Sub شاهد المرفق، If_Function_in_VBA.rar

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

الكود التالي يقوم بتنفيذ جميع ما طلبت: Private Sub Worksheet_SelectionChange(ByVal Target As Range) If ActiveCell.Address = "$B$2" Then For R = 3 To 29 Cells(R, 256) = Cells(R, 2) Cells(R, 2) = Sheet2.Cells(R, 2) Next Else: For R = 3 To 29 Cells(R, 2) = Cells(R, 256) Next End If End Sub شاهد المرفق .. أتمنى أن يكون هذا فعلاً ما تريد، _______________________________________________.rar

الكود التالي يقوم بإظهار جميع أوراق العمل المخفية دفعة واحد: Sub show() For Each WS In Worksheets WS.Visible = True Next End Sub

شاهد المرفق، If_in_VBA___Worksheet_Function.rar

بالنسبة للملاحظات على الملف عدد مرات التغير في خلية: 1- التاريخ الذي ظهر لدي في الخصائص هو نفسه التاريخ الذي يظهر الخلية B6 .. كما في المرفق، 2- التحديث يتم بشكل طبيعي .. ولكن لا تنسى أن تقوم بحفظ الملف قبل الخروج منه لكي يتم حفظ التحديثات. 3- عند خروج الرسالة التي تحدث عنها إضغط على Debug .. وإنسخ السطر المضلل باللون الأصفر وضعه هنا لكي يتم التعرف على السبب. أرجوا من الأخوان الذي أطلعوا على المرفقات أن يبدوا رأيهم .. لكي يتبين الخلل بالضبط إن وجد. بالنسبة للملاحظات على الملف Show File Access Information: 1- جميع التواريخ تعمل معي بشكل طبيعي وممتاز وبدون إختلاف عن المعلومات الموجودة في نافذة الخصائي .. كما هو واضح في المرفق. 2- بالنسبة للزر الأول والثاني فإنهما يعملان بشكل طبيعي وممتاز .. وأرجوا ممن حمل المرفق أن يذكر لنا إذا كانت الأزرار تعمل معه أم لا .. أما بالنسبة للزر الثالث (معلومات ملف آخر على الجهاز) .. فلتشغيله يلزمك إنشاء ملف نص على القرص D .. بإسم New Text Document .. أو أي ملف آخر مع مراعاة تغيير مساره داخل الكود. 3- لا أعتقد ذلك .. أرجوا من الأخوان إبداء رأيهم. 4- يتم تحديث آخر وصول وآخر تعديل عند حفظ الملف .. ولكي ترى أن هناك فرق لاحظ تاريخ التعديل بعد فتح الملف مباشرة. 5- نفس الإجابة بالنسبة للملف الأول. __________________.rar

الكود التالي يقوم بعملية التنسيق الشرطي كما في مشاركتي الأولى في هذا الموضوع .. ولكن هذه المرة يتم التنسيق الشرطي عن طريق الكود وليس عن طريق الصيغ كما في المشاركة المُشار إليها: Private Sub Worksheet_Change(ByVal Target As Range) TR = Target.Row Application.ScreenUpdating = False If Cells(TR, 1) <> "" And Cells(TR, 1).Row Mod 2 = 0 Then For C = 1 To 7 Cells(TR, C).Interior.ColorIndex = 34 Cells(TR, C).Font.ColorIndex = 41 Borders Next ElseIf Cells(TR, 1) <> "" And Cells(TR, 1).Row Mod 2 = 1 Then For C = 1 To 7 Cells(TR, C).Interior.ColorIndex = 41 Cells(TR, C).Font.ColorIndex = 34 Borders Next Else For C = 1 To 7 Cells(TR, C).Interior.ColorIndex = xlNone NonBorders Next End If Application.ScreenUpdating = True End Sub شاهد المرفق، ___________________________________________.rar

يكون ذلك بوضع الماكرو في الموديول الخاص بالصفحة وليس في موديول خارجي بالإضافة إلى تحديد عنوان أو صف أو عمود الخلية المرتبطة بالحدث

عفواً أخي الكريم .. نشكرك على هذه المشاركة .. ولكن الطريقة التي ذكرتها غير صحيحة .. صحيح أنه يتم ترقيم كل مجموعة على حدا بعد التصفية .. ولكن بعد عرض جميع السجلات (الصفوف) نلاحظ أن الأرقام التسلسلية غير متسلسلة .. فمن المفروض أن يبدأ الترقيم بـ 1 ثم 2 ثم 3 وهكذا .. وليس 1 ثم 1 ثم 2 ثم 2 .. هذا غير صحيح .. أليس كذلك؟؟ وللتأكد راجع مشاركتنا رقم 4 على هذا الموضوع .. لترى كيف يتم هذا النوع من الترقيم بإستخدام الدالة SUBTOTAL