مساعدة في طلب استدعاء بيانات

[أبو سـما]

مرفق ملف اكسل يحتوي على 3 ورقات عمل المطلوب معادلة أو كود في الورقة الثالثة التي تحمل اسم (طلبات) لاستدعاء بيانات مجمعة كما هو واضح في الملف المرفق وجزاكم الله عنا كل خير

انتبه من فضلك .. فطالما تريد الحل بالأكواد ..فلابد من رفع الملف بإمتداد يقبل الأكواد XLSM ... تـــم تعديل رفع الملف

test.xlsm

[lionheart]

Using formulas

-------------------

Column F Formula

=TEXTJOIN("-",TRUE,IF(الحركة!$A$2:$A$10=A2,الحركة!$F$2:$F$10,""))

Column G Formula

=IFERROR(LOOKUP(2,1/(الحركة!$A$2:$A$10=A2),الحركة!$J$2:$J$10),"")

 

Using VBA

--------------

Sub Test()
    Dim ws As Worksheet, sh As Worksheet, rng As Range, n As Long, r As Long
    Set ws = ThisWorkbook.Worksheets(2)
    Set sh = ThisWorkbook.Worksheets(3)
    Set rng = ws.Range("A2:A" & ws.Cells(Rows.Count, 1).End(xlUp).Row)
    n = sh.Cells(Rows.Count, 1).End(xlUp).Row
    For r = 2 To n
        sh.Cells(r, 6).Value = MyVLOOKUP(sh.Cells(r, 1).Value, rng, 6, "-")
        sh.Cells(r, 7).Value = LookupLast(sh.Cells(r, 1).Value, rng, 10)
    Next r
End Sub

Function MyVLOOKUP(ByVal myVal, ByVal rng As Range, ByVal colRef As Long, ByVal myStr As String)
    If Not IsNumeric(myVal) Then myVal = Chr(34) & myVal & Chr(34)
    With rng
        MyVLOOKUP = Join(Filter(.Parent.Evaluate("TRANSPOSE(IF(" & .Columns(1).Address & "=" & myVal & "," & .Columns(colRef).Address & "))"), False, 0), myStr)
    End With
End Function

Function LookupLast(ByVal txt As String, ByVal rng As Range, ByVal col As Integer)
    Dim i As Long
    For i = rng.Columns(1).Cells.Count To 1 Step -1
        If txt = rng.Cells(i, 1) Then LookupLast = rng.Cells(i, col): Exit Function
    Next i
End Function

 

[أبو سـما]

شكرا لك أخي قلب الأسد بالفعل نجحت بتوفير المطلوب بواسطة VBA لكن بالمعادلات عند تطبيق المعادلة الأولى لاستدعاء التواريخ يتم استدعاء كل التواريخ المسجلة بغض النظر عن الرقم المدون في خانة الكود والمعادلة الثانية تعمل جيدا وتستدعي آخر حالة لآخر تاريخ مدون مقابل الكود.

هل لابد من وضع زر لتنفيذ الvba ام هناك طريقة اخرى لكي يعمل الvba بمجرد كتابة رقم الكود فقط ؟

[lionheart]

 This formula returns only the results that match the criteria and not all the dates

=TEXTJOIN("-",TRUE,IF(الحركة!$A$2:$A$10=A2,الحركة!$F$2:$F$10,""))

 

[أبو سـما]

شكرا لك أخي قلب الأسد لكن طبقت المعادلة وبالفعل تظهر كافة التواريخ المدونة بورقة العمل 

[lionheart]

What about the VBA code? Is it working well or not

[أبو سـما]

Yes it works very well, thanks alot . But i prefer the solution with formulas if possible

[lionheart]

Can you attach your file to have a look at the problem? And what office version do you use

[أبو سـما]

test.xlsm

i use office 2019 at home and 2016 at work

[lionheart]

I think your office version doesn't support TextJoin function so you can use UDF that is alternative to TextJoin. You will use the same formula exactly but replace the name of TextJoin with MyTextJoin

Function MyTextJoin(break As String, ignore As Boolean, txt) As String
    Dim t, s$, i%
    For Each t In txt
        s = s & IIf(i = 0 Or (ignore = True And (s = "" Or t = "")), "", break) & t
        i = 1
    Next t
    MyTextJoin = s
End Function

 

[أ / محمد صالح]

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

حينما قال صاحب الاستفسار أن المعادلة الأولى لم تعمل قمت بالرد في موضوعي بدائل دالة textjoin حتى يظهر له الحل بطريقة غير مباشرة

بالتوفيق 

🙄😏

[lionheart]

Thanks a lot Mr. Mohamed but I have found that UDF in an English forum and not here but I don't remember the link. Generally, thanks for your great efforts.

I found the UDF on that link too

http://excel-egy.com/forum/t2146

[أ / محمد صالح]

ما شاء اللّه الأمانة العلمية متوفرة جدا

ولكن الحمد لله رغم تأخر نشري لهذا المجهود لي السبق

موضوع منتدى الصقر : الدالة المعرفة JoinEA بديل للدالة TEXTJOIN بتاريخ 18-08-2018 10:05 مساء

وموضوعي: مكتبة الموقع - بدائل دالة textjoin الموجودة في إكسل 2016 لجميع إصدارات اكسل mastextjoin بواسطة أ / محمد صالح, يناير 26, 2018

ربنا يصلح حالنا جميعا