المساعدة فى تخفيف من ثقل الملف

[هانى محمد]

السلام عليكم أساتذتى الكرام الرجاء من سيادتكم تسهيل العمل على هذا الملف فالملف ثقيل جداً والعمل عليه صعب جداً ..رجاءا من سيادتكم مساعدتى بإضافة المعادلات الموجودة بالعمود G من صفحة Main

=IFERROR($D3*@INDIRECT(ADDRESS(INDEX(MATCH($B3&$C3,Setting!$A$1:$A$74&Setting!$BB$1:$BB$74,0),),MATCH($F3,Setting!$B$1:$BA$1,0)+MATCH($E3,OFFSET(Setting!$B$2,0,0,1,MATCH($F3,Setting!$B$1:$BA$1,0)+9),0),,,"Setting")),"")

وكمان المعادلة الموجودة بالعمود H     بالكود حتى يسهل العمل على الملف ولكم جزيل الشكر وبارك الله فى جهودكم , وهذه عينة صغيرة جداً من الملف فالملف ثقيل جداً

=IFERROR($D3*@INDIRECT(ADDRESS(INDEX(MATCH($B3&$C3,Setting!$A$1:$A$74&Setting!$BB$1:$BB$74,0),),MATCH($F3,Setting!$B$1:$BA$1,0)+MATCH($E3,OFFSET(Setting!$B$2,0,0,1,MATCH($F3,Setting!$B$1:$BA$1,0)+9),0)+1,,,"Setting")),"")

 

Transportatio.xlsb

[حسونة حسين]

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

تفضل اخى @هانى محمد

Option Explicit
Sub Test()
    Dim WS As Worksheet, SH As Worksheet, Lr As Long, i As Long, A, B, C, D, E As Long, WF As Object
    Set WS = ThisWorkbook.Worksheets("Setting")
    Set SH = ThisWorkbook.Worksheets("Main")
    Lr = SH.Cells(Rows.Count, 1).End(xlUp).Row
    ReDim arr(3 To Lr, 1 To 2)
    For i = 3 To Lr
        A = Application.Match(SH.Range("B" & i), WS.Columns("a"), 0)
        If Not IsError(A) Then
            B = Application.Match(SH.Range("C" & i), WS.Columns("BB"), 0)
            If Not IsError(B) Then
                C = Application.Match(SH.Range("F" & i), WS.Rows(1), 0)
                If Not IsError(C) Then
                    If SH.Range("F" & i) = "Marsa Alam" Or SH.Range("F" & i) = "Cairo" Then
                        E = 8
                    Else
                        E = 9
                    End If
                    D = Application.Match(SH.Range("e" & i), WS.Range(WS.Cells(2, C), WS.Cells(2, C + E)), 0) - 1
                    If Not IsError(D) Then
                        arr(i, 1) = WS.Cells(A, C + D)
                        arr(i, 2) = WS.Cells(A, C + D + 1)
                    End If
                End If
            End If
        End If
    Next i
    SH.Range("G3").Resize(UBound(arr, 1) - 2, UBound(arr, 2)).Value2 = arr
End Sub

 

[هانى محمد]

بارك الله فيك أستاذنا الكبير حسونة حسين

لماذا لا يرحل هذا الكود كما كان يقوم الكود القديم ؟!!! هل هناك اضافة لهذا الكود حتى يقوم بالترحيل من صفحة Main بإسم كل شركة الموجود بالعمود C للصفحة التى تخص نفس الشركة                 .. وشكراً وأسف جداً على ازعاجكم

[حسونة حسين]

6 ساعات مضت, هانى محمد said:

لماذا لا يرحل هذا الكود كما كان يقوم الكود القديم

شغل الكود اخى هاني سوف يجلب البيانات في العامود g والعامود h بدلا من المعادله

الكود ليس له علاقه باي اكواد اخري

[هانى محمد]

بارك الله فى جهودكم .. هل يمكن دمج الكودين ؟ ولكم جزيل الشكر

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

كما ترى أستاذنا الكريم كل هذا الوقت أثناء عملية لصق البيانات

 

تم تعديل أكتوبر 7, 2023 بواسطه هانى محمد

[هانى محمد]

للرفع أكرمكم الله وبارك الله فى جهودكم

[حسونة حسين]

في 7‏/10‏/2023 at 09:13, هانى محمد said:

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

كما ترى أستاذنا الكريم كل هذا الوقت أثناء عملية لصق البيانات

اين يتم لصق البيانات اخى هانى؟

[هانى محمد]

بارك الله فيك وجزاك الله خير الثواب يتم لصق البيانات بصفحة Main فى كل الأعمدة ماعدا أعمدة المعادلات أى من العمود A حتى العمود F ومن العمود J حتى العمود K

وفرج الله لكم كربات يوم القيامة

تم تعديل أكتوبر 9, 2023 بواسطه هانى محمد