اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

الردود الموصى بها

قام بنشر

السلام عليكم ورحمة الله وبركاته ،،،

مرفق ملف اكسل به عدة اوراق عمل ومطلوب كتابة معادلة في ورقة العمل الرئيسية لاتستخراج اخر دفعة حصل عليها العميل وتاريخ الحصول عليها 

يرجى المساعدة مع الشكر ،،،

العملاء.xlsx

قام بنشر

شكرا أخي سليم على سرعة تفاعلك مع طلبي لكن عفوا اريد رقم الدفعة وليس مبلغها كما لاحظت عند حذف بيان لاختبار المعادلة مثلا عميل رقم واحد قد حصل على اربع دفعات فقط وعميلا رقم 2 قد حصل على ثمان دفعات فقط لا تعمل المعادلة بشكل صحيح.

قام بنشر

تمام شكرا لك اخي سليم لكن لاعتبارات اخرى اريدها بنفس التنظيم ، وقد حاولت ونجحت مع دالة max لاستخراج التاريخ لكني لم افلح في استخراج رقم الدفعة المقابل لها فهل هناك طريقة لاستخراج رقم الدفعة بناء على البحث عن التاريخ المعلوم في ورقة العمل واستخراج الرقم المقابل له عن طريق تطبيق الدوال التالية vloشokup أو hlookup أو match و index 

العملاء.xlsx

قام بنشر

بهذه الطريقة صجيج انك تحصل على اكبر تاريخ لكن !!!!
1- ربما كانت التواريخ في مرتبة تصاعدياً (عتدها لا تكون اخر دفعة)

2- كيف تجد في اي عامود موجود هذا التاريخ؟؟؟؟
 

  • Like 1
قام بنشر

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

قام بنشر

انا عملت الحل ده مؤقتا لحد ما اشوف بديل او اعدل في التصميم واخليها كلها تحت بعض زي ما حضرتك تفضلت بحلها

اخترت اعلى رقم تم ادخاله في الاعمدة واحدث تاريخ كذلك بواسطة max

العملاء.xlsx

  • أفضل إجابة
قام بنشر

 حرب هذا الماكرو     
 (تم ادراج اسماء الصفحات (Code Name   اي الأسماء البرمجية) باللغة الأجنبية لعدم ظهور  احرف غريبة و غير   مفهومة في الكود مما يسهل   عملية تسخه ولصقه من جهة
 و من جهة ثانية لا أحب الكتابة باللغة العربية داخل اي الكود)

Option Explicit
'++++++++++++++++++++++++++++++++++++
Dim sh As Worksheet
Dim LastRow%, ro%, i%, m%, Last%
Dim someRange As Range
Dim My_Area As Range
Dim Signle_cel As Range
Dim adr1$, adr2$
Dim Ar(), itm
'+++++++++++++++++++++++++++++++++++++
Sub Get_Sheet_name()
Dim curt_rg As Range
Set curt_rg = Main.Range("A2").CurrentRegion
Last = curt_rg.Rows.Count
If Last > 1 Then
curt_rg.Offset(1).Resize(Last - 1).ClearContents
End If
i = 0
For Each sh In Sheets
    If sh.Name <> Main.Name Then
        Main.Range("A3").Offset(i) = sh.Name
        ReDim Preserve Ar(i)
        Ar(i) = sh.Name
        i = i + 1
    End If
 Next
End Sub
'+++++++++++++++++++++++++++++++++++++++

Sub lasl_cell()
Get_Sheet_name
 m = 3
For Each itm In Ar
      adr1 = "": adr2 = ""
      Set sh = Sheets(itm)
      ro = sh.Cells(Rows.Count, 1).End(3).Row
         sh.Range("A3").Resize(ro - 1, 9) _
         .Interior.ColorIndex = xlNone
          Set someRange = Union(sh.Range("A2:A" & ro), _
          sh.Range("D2:D" & ro), sh.Range("G2:G" & ro))
      
      For Each My_Area In someRange.Areas
          For Each Signle_cel In My_Area.Cells
             If Signle_cel = "" Then GoTo Put_It
              adr1 = Signle_cel.Address
              adr2 = Signle_cel.Offset(, 2).Address
          Next Signle_cel
      Next My_Area
Put_It:
      
      If adr1 <> "" And adr2 <> "" Then
         sh.Range(adr1).Resize(, 3). _
          Interior.ColorIndex = 35
        With Main.Cells(m, 2)
          .Value = sh.Range(adr1)
          .Offset(, 1) = sh.Range(adr2)
        End With
      End If
  m = m + 1
Next itm
 
End Sub

 

 

OUMALA3_New.xlsm

  • Thanks 1
قام بنشر

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

لك كل الشكر والتقدير على الحل والتفاعل أخي الكريم

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

شكرا لك أخي سليم على جهودك المباركة بالحل بأكثر من طريقة وجزاك الله عنا خير الجزاء.

 

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information