سليم حاصبيا

اثراءً للموضوع هذه المعادلة (بدون Ctrl+Shift+Enter) اقصد معادلة عادية =LOOKUP(H9&I9,$A$2:$A$12&$B$2:$B$12,$C$2:$C$12)

تم التعديل مرة ثالثة الترحيل حسب الموقعsalim3.rar

1-انسخ هذه المعادلة الى الخلية J9 2- اضغط (Ctrl+Shift+Enter) 3-اسحب المعادلة الى باقي الصفوف =INDEX($C$2:$C$12,MATCH(H9&I9,$A$2:$A$12&$B$2:$B$12,0))

مشكور اخي ياسر على هذه الملاحظة القيمة تم التعديل على الكود المذكور تم التعديل مرة اخرى بواسطة هذا الكود Sub CreateSheets() Dim ws As Worksheet Dim K As Range Dim ListSh As Range Application.ScreenUpdating = False With Worksheets("tafasil") Set ListSh = .Range("o2:o" & .Cells(.Rows.Count, "o").End(xlUp).Row) End With On Error Resume Next For Each K In ListSh Worksheets("tafasil").Activate If Len(Trim(K.Value)) > 0 Then y = Worksheets(Trim(K.Value)).Name t = Application.CountIf(Range("o2:o" & K.Row), Trim(K.Value)) If IsEmpty(y) And t = 1 Then Worksheets.add(After:=Worksheets(Worksheets.Count)).Name = K.Value ActiveSheet.Range("a1:d1") = Array("الاسم", "الرقم", "الفرق", "الموقع") '============================================ End If y = Empty End If Next K Application.ScreenUpdating = True Worksheets("tafasil").Select End Sub و تغيير مسح البيانات الى هذا الكود Sub del_data() For mh = 2 To Sheets.Count Sheets(mh).Range("A2:d5000").ClearContents Next Sheets("tafasil").Select Range("a2").Select End Sub و الكود النهائي الى هذا الكود Sub AddValues() Dim My_sheet As Worksheet Dim i As Single '============================= Application.ScreenUpdating = False CreateSheets answer = MsgBox("هل تريد مسح البيانات في الاوراق الباقية أولاً ", vbQuestion + vbYesNo + vbMsgBoxRtlReading) If answer = 6 Then del_data lr_MAIN = Sheets("tafasil").Cells(Rows.Count, 1).End(3).Row If lr_MAIN < 2 Then lr_MAIN = 2 For K = 2 To lr_MAIN '========================================== On Error Resume Next Set My_sheet = Sheets("" & Sheets("tafasil").Range("O" & K)) If Sheets("tafasil").Range("O" & K) = "" Then GoTo 1 '========================================== With My_sheet i = .Range("A" & Rows.Count).End(xlUp).Row + 1 .Range("A" & i) = Sheets("tafasil").Range("A" & K) .Range("b" & i) = Sheets("tafasil").Range("b" & K) .Range("c" & i) = Sheets("tafasil").Range("e" & K) .Range("d" & i) = Sheets("tafasil").Range("O" & K) .Range("a2").Select End With '========================================== 1: Next Application.ScreenUpdating = True Sheets("tafasil").Range("a1").Select End Sub ليصبح الشكل النهائي للملف هكذا الترحيل حسب الموقعsalim2.rar

استعمل هذه المعادلة واسحب نزولاً =CEILING(D3/10^12,0.05)

مشكور اخي ياسر على هذه الملاحظة القيمة تم التعديل على الكود المذكور الترحيل حسب الموقعsalim1.rar

رتب الجدول عي هذا الشبت ابتداءً من الخلية A وحتى الخية D مثل باقي الصفحات

ربما كان المطلوب الترحيل حسب الموقعsalim.rar

جرب هذا الماكرو يعمل فقط على العامود A يمكن التغيير الى اي عامود (اعمدة تشاء) Private Sub Worksheet_Change(ByVal Target As Range) If Target.Column = 1 And IsNumeric(Target) Then On Error Resume Next If Int(Target) = Target Then Target.NumberFormat = Selection.NumberFormat = "\$ 0" If Int(Target) <> Target Then Target.NumberFormat = "\$ 0.00" End If End Sub

جرب هذا المرفق Book1salim.rar

جرب هذا الملف Sort_A salim.rar

رائـــع!!!!!

اين الاعجاب بالكود

الى اين تريد الترحيل اقصد الى اي ورقة

تم التعديل على الملف حسب ما تريد انظر الى الصفحة salim معرفات مكررة بفواتير مختلفة salim2.rar

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

جرب هذا الملف حاول التعديل على البيانات بزيادة او نقصان عدد الفواتير او الحسابات المعرفة و ستلاحظ ان كل شيء يتغير معرفات مكررة بفواتير مختلفة salim.rar

=IF($A1<>$A2,$A2,"") ارفع الملف نفسه وليس صورة عنه على كل حال لنفرض ان معرف الحساب موجود في العامود A ابتداءً من الخلية A2 اكتب هذه المهادلة في اي عامود ابتداءً من الصف 2 واسحب نزولاً

جرب هذا الملف ترتيب أبجدى 2003 salim.rar

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

جرب هذا الملف ترتيب الناجح و الراسب salim.rar

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

هذه العلامة تظهر اذا كان الملف محفوظ بصيغة xlsm و الاصدار 2007 ما فوق

هذا ليس خطأ علامة التعجب هذه تشير الى ان الملف يحنوي على ماكرو

جرب هذه المعادلة (معادلة صفيف يلزمها Ctrl+Shift+Enter) ربما تفي بالغرض =SUMPRODUCT(IF(FREQUENCY(IF(ISNUMBER(--(LEFT($C$5:$C$8,1))),--(LEFT($C$5:$C$8,1)),0),IF(ISNUMBER(--(LEFT($C$5:$C$8,1))),--(LEFT($C$5:$C$8,1)),0)),--(LEFT($C$5:$C$8,1)),""),--($B$5:$B$9=1)) اذا لم تؤدي الى نتيجة استبدل الفاصلة , بفاصلة منقوطة ;