پرسش کمک برای بهبودد سرعت فایل Inventory

[prince66]

سلام به همه دوستان

تقریبا یکسال پیش فایل اکسل مربوط به کنترل موجودی رو به کمک دوستان عزیز در اکسل ایران تهیه کردم
اما به مرور با زیاد شدن دیتا ، سرعت فایل به شدت کند شد.
در فایل پیوست وقتی از شیت ورودی یا خروجی روی شیت موجودی (sb) کلیک می کنم تا موجودی لود بشه نزدیک به 3 دقیقه طول میکشه میخواستم از شما دوستان راهنمایی بگیرم تا این سرعت رو بیشتر کنم
همچنین من مقدار موجودی رو با فرمول sumifs ایجاد کردم ممنون میشم اگر راهنمایی کنید همین فرمول رو تو vba بیارم.

تشکر

[M_ExceL]

سلام به همه دوستان

تقریبا یکسال پیش فایل اکسل مربوط به کنترل موجودی رو به کمک دوستان عزیز در اکسل ایران تهیه کردم
اما به مرور با زیاد شدن دیتا ، سرعت فایل به شدت کند شد.
در فایل پیوست وقتی از شیت ورودی یا خروجی روی شیت موجودی (sb) کلیک می کنم تا موجودی لود بشه نزدیک به 3 دقیقه طول میکشه میخواستم از شما دوستان راهنمایی بگیرم تا این سرعت رو بیشتر کنم
همچنین من مقدار موجودی رو با فرمول sumifs ایجاد کردم ممنون میشم اگر راهنمایی کنید همین فرمول رو تو vba بیارم.

تشکر

سلام،
فکر میکنم براحتی می تونید با پیوت تیبل گزارشی که می خواهید رو تهیه کنید.
ابتدا لیستتون رو به تبیل تبدیل کنید سپس با استفاده از پیوت تیبل می تونید اطلاعات مورد نظر رو استخراج کنید.

[prince66]

سلام
تشکر بابت راهنمایی ، ولی ممنون میشم در قالب همین فایل و در بهبود سرعت و کارایی کد های نوشته شده ،کمک کنید
تشکر

[prince66]

دوستان ممنون میشم کمک کنید

[~M*E*H*D*I~]

سلام به همه دوستان

تقریبا یکسال پیش فایل اکسل مربوط به کنترل موجودی رو به کمک دوستان عزیز در اکسل ایران تهیه کردم
اما به مرور با زیاد شدن دیتا ، سرعت فایل به شدت کند شد.
در فایل پیوست وقتی از شیت ورودی یا خروجی روی شیت موجودی (sb) کلیک می کنم تا موجودی لود بشه نزدیک به 3 دقیقه طول میکشه میخواستم از شما دوستان راهنمایی بگیرم تا این سرعت رو بیشتر کنم
همچنین من مقدار موجودی رو با فرمول sumifs ایجاد کردم ممنون میشم اگر راهنمایی کنید همین فرمول رو تو vba بیارم.

تشکر

دوست عزیز من یک فایل دارم که 72 مگابایت حجم داره و باهاش کار میکنم ، فایل شما که در مقایسه با اون هیچ حجم خاصی نداره ، توصیه میکنم از فرمولهای آرایهای استفاده نکنی، جز در مواقع ضروری از افکتهای رنگی و ... استفاده نکنی تا جای ممکن پیوت تیبل و توابع مربوط به بانکهای اطلاعاتی استفاده کن

یه بررسی اجمالی هم کردم فایل شما ایراد اساسیش در ماکرو read_write() هست که دو تا حلقه for تو در تو ایجاد کردی که مدام در حال رشده
منطق این برنامه رو نمیدونم چیه ولی فکر میکنم این ماکرو به راحتی با یک فرمول میتونه جایگزین بشه

For i = 2 To n_row
    '-- check duplicate part_no & CR --'
    For ii = i To n_row - 1
        If inbound_data(ii, 4) = inbound_data(i - 1, 4) And inbound_data(ii, 5) = inbound_data(i - 1, 5) And inbound_data(ii, 6) = inbound_data(i - 1, 6) And inbound_data(ii, 7) = inbound_data(i - 1, 7) Then GoTo 10
    Next ii
    
    counter = counter + 1
    Sheets("SB").Cells(counter, 1) = counter - 1
    Sheets("SB").Cells(counter, 3) = Sheets("Inbound Tracking").Cells(i, 4)
    Sheets("SB").Cells(counter, 2) = Sheets("Inbound Tracking").Cells(i, 5)
    Sheets("SB").Cells(counter, 4) = Sheets("Inbound Tracking").Cells(i, 6)
    Sheets("SB").Cells(counter, 6) = Sheets("Inbound Tracking").Cells(i, 7)
    Sheets("SB").Cells(counter, 10) = Sheets("Inbound Tracking").Cells(i, 9)

10
Next i 

[M_ExceL]

سلام
تشکر بابت راهنمایی ، ولی ممنون میشم در قالب همین فایل و در بهبود سرعت و کارایی کد های نوشته شده ،کمک کنید
تشکر

سلام،
با اجازه استاد گرانقدر و عزیز جناب ~M*E*H*D*I~
کد جدید و بهینه تری برای شما نوشتم که در کسری از ثانیه انجام می دهد.
در فایل پیوست روی باتن 1 کلیک کنید.

Sub M_excel()

Dim table_array As Variant
Dim new_array As Variant
Dim unique_values As New Collection
Dim itm As Variant
Dim cc As Byte
Dim i, s As Long

table_array = Sheets(2).ListObjects("Table4").DataBodyRange.Value
Sheets(4).Range("a2:k" & Sheets(4).UsedRange.Rows.Count).ClearContents

    For i = LBound(table_array) To UBound(table_array): On Error Resume Next
        unique_values.Add CStr(table_array(i, 5) & table_array(i, 6)), _
        CStr(table_array(i, 5) & table_array(i, 6))
    Next: Err.Clear: On Error GoTo 0

ReDim new_array(1 To unique_values.Count, 1 To 11): s = 1
    For Each itm In unique_values
        For i = LBound(table_array) To UBound(table_array)
            If itm = CStr(table_array(i, 5) & table_array(i, 6)) Then
                    For cc = 1 To 11
                        If cc = 1 Then
                        new_array(s, cc) = s
                        ElseIf cc = 8 Then
                        new_array(s, cc) = new_array(s, cc) + table_array(i, cc)
                        Else: new_array(s, cc) = table_array(i, cc)
                        End If
                    Next
            End If
        Next
        s = s + 1
    Next
Sheets(4).Range("a2:k" & s).Value = new_array
End Sub

اگر مشکل یا تغییراتی مد نظر بود در خدمتیم.

[prince66]

ممنون از لطف شما دوستان