أبوبسمله

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

ابو اسيل جزاك الله كل خير لما جيت اعمل ملف تنفيذى بالبورتبول ملقتش المارك متفعله هيا مش متفعله عليه ليه

ههههههههههههههه تمام بس انا جربت معظمهم شغال ياغالى يمكن من السهر هيست او يمكن لما وصلت هنجت حبيبى هجرب المعادله جزاك الله كل خير يا ابو البراء

اليوم والشهر بالهجرى تلقائى بالتوفيق اخوانى الاحباب التاريخ بالهجرى بشكل تلقائى.rar

البركه فى الغالى ابوالبراء جزاه الله كل خير اشوفكم باعد الصلاه بقا ان شاء الله طبتم واهتديتم

صباح الخيرات جزاك الله خيرا ابو يوسف هو نفس الكود اللى ارفقته ولكن بدون استخدام الاداه وتعديل كما اشار اخى ابو البراء فى السطر الاخير فقط ليتم العكس فى عمود b WorkRng.Offset(, 1).Formula = Arr طبتم واهتديتم

بعد اذن اخى ياسر هل هذا ما تريد؟ Book11.zip

جزاك الله خيرا يا ابو البراء بالنسبه لسؤالى فاعتقد انها لن تؤثر لان المعادله اللى اللى هستخدمها هيى لا ستخراج التاريخ من الرقم القومى فمش هتكون لها تاثير على اى صف تانى واذا كان هناك اى توضيح او لبس نرجو توضيحه فمنكم نتعلم ونستفيد لنرتقى جزاك الله كل خير اخى ياسر وبارك الله لك فى اهلك ومالك ووقتك ورزقك من حيث لا تحتسب

بصبح على الغالى هديه لحبيبى واخى الغالى ابو البراء احلى مجموعة اكواد * فى كود واحد لم استطع تجربته فايريت تقلى الطريقه انا كاتب عليه ملحوظه Sub Demo1() VA = [A1:A4].Value [B1:B4].Value = Application.Transpose(Array(VA(4, 1), VA(3, 1), VA(2, 1), VA(1, 1))) End Sub '============================================================================== Sub Demo2() [B1:B4].Value = Evaluate("{""" & [A4].Value & """;""" & [A3].Value & """;""" & [A2].Value & """;""" & [A1].Value & """}") End Sub '=============================================================================== Sub Test() Dim Arr, Temp, I As Long, P As Long Arr = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) ReDim Temp(UBound(Arr) - 1) For I = UBound(Arr) To LBound(Arr) Step -1 Temp(P) = Arr(I, 1) P = P + 1 Next I Range("B1").Resize(UBound(Arr)).Value = Application.Transpose(Temp) End Sub '============================================================================== Sub test() With Range("a1", Range("a" & Rows.Count).End(xlUp)) .Offset(, 1).Value = Application.Index(.Value, Evaluate("if(row(" & .Address & "),large(row(" & .Address & "),row(1:" & .Rows.Count & ")))")) End With End Sub '================================================================================ 'ملحوظه الكود ده لم استطع تجربته فما ى طريقته B1: =OFFSET($A$1,COUNTA($A:$A)-ROW(),) Copy down '================================================================================ Public Sub InvertUsingArrayList() Dim objArrList As Object: Set objArrList = CreateObject("System.Collections.ArrayList") Dim reverseArr For i = 1 To Range("A" & Rows.Count).End(xlUp).Row objArrList.Add Range("A" & i).Value Next i objArrList.Reverse reverseArr = objArrList.ToArray Range("B1:B" & Range("A" & Rows.Count).End(xlUp).Row).Value = Application.Transpose(reverseArr) End Sub '================================================================================ Sub test() Dim a, i As Long, temp With Range("a1", Range("a" & Rows.Count).End(xlUp)) a = .Value For i = 1 To UBound(a, 1) \ 2 temp = a(UBound(a, 1) - i + 1, 1) a(UBound(a, 1) - i + 1, 1) = a(i, 1): a(i, 1) = temp Next .Offset(, 1).Value = a End With End Sub '================================================================================ جزاك الله كل خير يا ابوالبراء

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

جزاك الله خيرا يا ابوالبراء بعد إذنك شوف المعادله دى هيا شغاله بس ملخبطه مش عارف ليه

ده ملف مشابه للطلب للاستفاده والافاده بالتوفيق Extracting-a-unique-sorted-list-based-on-frequency-of-occurrence.rar

جزاك الله كل خير على التعديل وزى ما انت عارف انا على قدى فامتعتبش عليا دى معادله بس عاوزه برضه شويه ظبط منكم =LOOKUP(REPT(“z”;99);CHOOSE({1,2};””;IF(ROWS(E$4:E4)<=F$1;INDEX(costcenter;MODE(IF((costcenter<>””)*ISNA(MATCH(costcenter;E$3:E3;0));MATCH(costcenter;costcenter;0)*{1;1})));””))) بالتوفيق حبايبى

اخوانى الاعزاء اشارككم الكود الجميل ده مرفق معه اداه تحملوها وباعد ما تضغط رن هيفتحلك انبوت حدد الرنج المراد عكسه بس هنا بيعكسه فى محله اكتشفوا الكود والاداه جميله وفيها حاجات كتير اوى طبعا انتم الاساتذه تعرفونا ايه استعملاتها رابط المصدر رابط الاداه للتحميل Sub FlipColumns() 'Updateby20131126 Dim Rng As Range Dim WorkRng As Range Dim Arr As Variant Dim i As Integer, j As Integer, k As Integer On Error Resume Next xTitleId = "KutoolsforExcel" Set WorkRng = Application.Selection Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8) Arr = WorkRng.Formula For j = 1 To UBound(Arr, 2) k = UBound(Arr, 1) For i = 1 To UBound(Arr, 1) / 2 xTemp = Arr(i, j) Arr(i, j) = Arr(k, j) Arr(k, j) = xTemp k = k - 1 Next Next WorkRng.Formula = Arr End Sub بالتوفيق اخوانى

منا عارف بس لما ترجمت عكس فى جوجل وبحثت مطلعليش اى حاجه خالص لان تقريبا الترجمه مش مظبوطه مع المتوقع بارك الله فيك اخى

عقدتها اكتر ياعم سليم واتبسط شوفوا بقا مين اللى هيحللكوا الواجب ده هههههههههههههههههههه جزاكم الله خيرا اخوانى

حبيبى يا ابو البراء يالا نفختنا وراك هههههههههه ارحمنا شويه من الاسئله الصعبه دى احنا لسه عضمنا طرى جزاك الله كل خير يا أبو البراء

شوف يا عم ابو البراء انت عمال تجيبلنا موضوعات صعبه انا كل اللى عرفت اعمله احط معادله فى الست خانات باستعمال اوفست دى اول خانه والبقيه تحتها =OFFSET(A1;5;0) حاولت اعمل مصفوفه معرفتش حاولت اظبطها باوفيست فى Vba برضه معرفتش يالا مش مشكله هنحاول تانى وجزاك الله كل خير والنبى والنبى يا استاذ امتحنا امتحان سهل احنا ساقطين لوحدنا ههههههههههههههههههههههه

انا اللى بنتظرك حبيبى ابو البراء جهزت موضوع الاسبوع ولا لسه ياغالى جزاك الله كل خير يا ابو البراء

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

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

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

لادراج اليوم تلقائى بتقريرك بالتوفيق

اتفضل اخى الفاضل ان شاء الله يكون كما تريد ناقص جزئيه بسيطه ألا وهى لصق البيانات بدون معادلات والحفاظ على المعادلات بالشيت الاول ان شاء الله ساحاول فيها Sub PasteRowDelete() Application.ScreenUpdating = False Worksheets("ضع هنا اسم الشيت اللى سيتم النسخ منه").Select ActiveCell.EntireRow.Select Selection.Cut Sheets("هنا ضع اسم الشيت اللى سيتم النسخ اليه").Select Range("A65536").End(xlUp).Offset(1, 0).Select ActiveSheet.Paste Application.CutCopyMode = False Sheets("ضع هنا اسم الشيت اللى سيتم النسخ منه").Select Selection.Delete Shift:=xlUp ActiveCell.Select Application.ScreenUpdating = True End Sub بالتوفيق اخى ونرجو منك تغيير الاسم الى اللغه العربيه لنتعرف بشخصكم الطيب

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