سليم حاصبيا

ادخل على الورقة 1 هناك عامودين مخفيين K &M اظهر هذين العامودين و غير الرقم 200 الى 1000 اضغط(Crt+shift+Ener) لان المعادلة صفيف ثم اسحب المعادلة الاولى الى K1000 ثم اسحب المعادلة الثانية الى M1000 نفس الشيء في الصفحة 2 الغمود C نسخ الخلية في A1 الى A8:a1000 نسخ الخلية في B1 الى b8:b1000

جرب هذا الملف Customer's Account salim.rar

جرب الملف المرفق WALID salim.rar

ارفع الملف (او قسماً منه اذا كان كبيراً)للمعالجة

انقل الشيت اللي انت بتشتغل فيه الى أول اللائحة بالشيتات و الماكرو سيغمل طبيغى (لان الماكرو مصصم غلى ان يبدأ من الشيت رقم2 الى الاخر)

جرب هذا الماكرو Sub sum_of_Many_sheets1() Dim My_sheet As Worksheet Set My_sheet = Sheets("total") x = Sheets.Count My_sheet.Cells(7, 3).Activate For i = 0 To 4 K = 0: s = 0: t = 0 For j = 2 To x t = Sheets(j).Cells(9, 42 + i).Value ' My_sheet.Cells(K + 1, 4) = t K = K + 1 s = s + t Next ActiveCell = s ActiveCell.Offset(1, 0).Activate Next ActiveCell.Delete End Sub

الملف لا يفتح عندي انه مصر على كلمة السر

كيف تريد الحل مغ ملف مقفل بكلمة سر

جرب ان تستبدل الفاصلة بفاصلة منقوطة في المغادلة

جرب هذه المعادلة في الخلية A12 =CHOOSE((SUM($A$2:$A$11)=1)+1,"مرفوض",SUM($A$2:$A$11))

لا يجوز وضغ كودين لنفس الحدث Workbook_Open يمكن دمجهما في كود واحد

الملف الجديد لا يمكن تنزيله لا اعرف السبب جرب تحميله مرة اخرى

استبدل الكود بهذا (لا يسمح بتحديد الخلايا التي تحتوي غلى معادلة- لعدم العيث بها عن طريق الخطأ) Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row >= 5 And Target.Column <= 11 And Target.Count = 1 Then _ Target.Offset(0, 1).Select If Target.Column = 9 Then Target.Offset(0, 2).Select If Target.Column = 11 Then Target.Offset(1, -9).Select End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Target.Column = 10 Then If Target.Row >= 4 Or Target.Row <= 15 Then Target.Offset(0, 1).Select End If End Sub

تفضل يا صديقي Least And Most Occurence salim.rar

المعادلات الموضوعة تكرر البحث (جرب ابحث عن محمد 1 مثلاً) و سترى النتيجة اما بالنسبة لمكان وضغ خلية البحث يمكنك تغييره من داخل المعادلة فقط استبدل في الخلية B5 بهذه المعادلة واسحبها يساراً الى E5 ثم نزولاً الى E100 أو قدر ما تشاء(لتصبح في النطاق E100 <<<<< A5 لا تنس ان تضع الاسم المراد البحث عنه في الخلية A20 (قم بنسخ الخلية A2 الى الخلية A20) اليك المعادلة =IF(ROWS(B$5:B5)>COUNTIF(Sheet1!$A$2:$A$100,$A$20),"",INDEX(Sheet1!B$2:B$100,SMALL(IF(Sheet1!$A$2:$A$100=$A$20,ROW(Sheet1!B$2:B$100)-ROW(Sheet1!B$2)+1),ROWS(B$5:B5))))

اخي بن علية ارجو ان تتطلع على مشاركتي بهذا الموضوع اعتقد انه الحل الاسهل لهذا الامر (فهو يعتمد على الترقيم) كما ذكرت حضرتك

اخي محسن الامر ليس متعلقاً بالعدد 6 او 7 أو 50 يجب ان يكون النطاق ديناميكياً بمعنى انه مهما بلغ عدد الاسماء (زيادة او نقصان ) يثحدث كل شيء (مع غض النظر عن الخلايا الفارغة) و الا لما لزوم كل ذلك حيث ان هناك مغادلة أو بالاحرى معادلات تستطيع ان تفي بالغرض

ربما يكون المطلوب Least And Most Occurence salim.rar

جرب هذا الملف كنموذج Nageh_Rasseb.rar

حل اخر (حيث ان الوقت يتعير كل ثانية) Private Sub Workbook_BeforePrint(Cancel As Boolean) If ActiveSheet.Range("xfd1") <> Date + Time Then Cancel = True End Sub Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) If Target.Address = "$XFD$1" Then Range("a1").Select If ActiveSheet.Name = ("Sheet1") Then ActiveSheet.Range("$XFD$1") = Date + Time End If End Sub

ما تنساش ما قلته لك ان الكود يجب تشفيره بحيث لا يمكن الدحول اليه الا من خلال باسوورد

أخي ياسر ممكن ان نستعمل هذين الكودين و ما عليك سوى تشفيرها بواسطة كلمة سر (اذا احببت التعديل غليها او الغائها) و يا مين يجطر غلى باله ان يمسح الخلية XFD1 Private Sub Workbook_Open() With Sheets("Sheet1").Range("xfd1") .Value = "D'ont print" .NumberFormat = ";;;" End With End Sub Private Sub Workbook_BeforePrint(Cancel As Boolean) If Sheets("sheet1").Range("xfd1").Value = "D'ont print" Then Cancel = True End Sub

ضع هذا الماكرو Private Sub Workbook_BeforePrint(Cancel As Boolean) Cancel = True End Sub اعتذر اخي احمد لم ار مشاركتك في هذا الموضوع الا بعد تحميل مشاركتي هذه

جرب هذا الملف من دون ماكرو khaled3 salim.rar

بعد اذن اخي وصديقي بن علية هذا حل احر بواسطة الماكرو Book1 salim.rar