ভিবিএ ম্যাক্রো অপ্টিমাইজ কিভাবে

Question

আমি এক্সেল এই ম্যাক্রো অপ্টিমাইজ করার আপনার সাহায্য প্রয়োজন। আমি আমাদের হাসপাতালে কেমোথেরাপির ওষুধের জন্য লেবেলগুলির জন্য ডেটা জেনারেট করার জন্য এটি ব্যবহার করছি। ম্যাক্রো এখন ঠিক সূক্ষ্ম কাজ করে, কিন্তু কখনও কখনও এটি উৎপন্ন করার জন্য একটি দীর্ঘ সময় লাগে। এটি একটি অলাভজনক প্রকল্প এবং অবশ্যই আমি ব্যবস্থাপনা থেকে কোন সাহায্য পাই না। আমি কোন পরামর্শ বা সাহায্যের জন্য কৃতজ্ঞ হতে চাই।

Dim i, iLastRow, d As Integer
Dim date1, date2 As Date
Dim oLastRow As ListRow
Dim srcRow As Range
Dim date_tabela As Date
Dim ile_dawek As Integer

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.StatusBar = False
Application.EnableEvents = False
ActiveSheet.DisplayPageBreaks = False
date1 = Worksheets("Program").Range("E2")
date2 = Worksheets("Program").Range("E3")
iLastRow = Worksheets("Program").ListObjects("Program").ListRows.Count + 6
For i = 7 To iLastRow
date_tabela = Cells(i, 4).Value
ile_dawek = Cells(i, 11).Value 
    If date_tabela >= date1 And date_tabela <= date2 Then
        For d = 1 To ile_dawek
            Set srcRow = Worksheets("Program").ListObjects("Program").Range.Range(Cells(i - 5, 1), Cells(i - 5, 36))
            Set oLastRow = Worksheets("Etykiety").ListObjects("Etykiety_druk").ListRows.Add()
            srcRow.Copy
            oLastRow.Range.PasteSpecial xlPasteValuesAndNumberFormats
            Application.CutCopyMode = False

        Next
     End If
Next
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = True
Application.EnableEvents = True
ActiveWorkbook.Save
End Sub

Comments

আপনি বলতে অনুকূল? তাই এটা ইতিমধ্যে কাজ করে? Codereview.stackexchange চেক আউট!

— Raystafarian

Answer 1

সঞ্চালনের গতি বাড়ানোর এক উপায় হল লুপে বার বার একই মানগুলি পুনরায় কম্পিউটিং করা।

উদাহরণ:

Worksheets("Program").ListObjects("Program").Range

একটি পরিবর্তনশীল এটি নির্ধারণ করুন (উদাহরণ: programRange) এবং ভেরিয়েবল ব্যবহার subrange নির্বাচন করতে। আপনি oLastRow অভিব্যক্তি সঙ্গে একই কাজ করতে পারেন।

দ্বিতীয়, কিছু গণনা তারিখ তুলনা উপর নির্ভর করে, আপনি পরীক্ষা ব্যর্থ হলে আপনার প্রয়োজন হয় না যে মান গণনা এড়াতে পারেন। আইএফ স্টেটমেন্টের ভিতরে আপনি 'ile_dawek' সেট করতে পারেন।

অবশ্যই অন্যান্য অপ্টিমাইজেশন আছে কিন্তু তারা আরও বিশ্লেষণ প্রয়োজন।

অবশ্যই, লুপ (গুলি) আগে বরাদ্দ করা।

Comments

আমি এই ধারণা দ্বিতীয়। আপনি একটি লুপের মধ্যে যতটা সম্ভব কম্পিউটিং এড়াতে এবং কম্পিউটেড মান ধারণকারী একটি পরিবর্তনশীল শুধুমাত্র পুনরাবৃত্তি করার চেষ্টা করুন। আমার প্রমাণ করার জন্য আমার কাছে কোন প্রমাণ নেই

— Prasanna

আমার প্রথম চিন্তা কেবল একটি অ্যারের মধ্যে পুরো জিনিস পড়তে হবে এবং আপনার looping সেখানে হবে ..

— Raystafarian

Answer 2

এক দ্রুত জিনিস

Dim i, iLastRow, d As Integer
Dim date1, date2 As Date
Dim oLastRow As ListRow
Dim srcRow As Range
Dim date_tabela As Date
Dim ile_dawek As Integer

বহু ঘোষিত ভেরিয়েবল একটি দেওয়া হয় না আদর্শ , শুধুমাত্র শেষ এক - আপনি প্রয়োজন

Dim i as long, iLastRow as long, d as long

যখন আপনি আপনার পরিবর্তনশীল সংজ্ঞায়িত না করেন, VBA এটি হিসাবে ঘোষণা করবে বৈকল্পিক , কোনটি বস্তু :

কর্মক্ষমতা । আপনি যে বস্তুটি অবজেক্ট টাইপের সাথে ঘোষণা করেন তা কোন বস্তুর একটি রেফারেন্স ধারণ করতে যথেষ্ট নমনীয়। যাইহোক, কখন   আপনি যেমন একটি পরিবর্তনশীল একটি পদ্ধতি বা সম্পত্তি আহ্বান, আপনি সবসময় incur   দেরী বাঁধাই (রান সময়)। প্রারম্ভিক বাঁধাই বাধ্য করা (কম্পাইল সময় সময়ে)   এবং ভাল কর্মক্ষমতা, একটি নির্দিষ্ট বর্গ সঙ্গে পরিবর্তনশীল ঘোষণা   নাম, বা নির্দিষ্ট তথ্য টাইপ এটি নিক্ষেপ।

পরিবর্তনশীল ঘোষণা না করে, আপনি সম্ভবত একটি শাস্তি পরিশোধ করা হতে পারে।

Answer 3

আপনার কোডটি অপ্টিমাইজ করার জন্য কিছু সাধারণ নিয়ম রয়েছে:
- পুরোপুরি যোগ্যতাসম্পন্ন রেফারেন্স পরিবর্তে স্থানীয় ভেরিয়েবল ব্যবহার করুন
- সঠিক ধরন সঙ্গে ভেরিয়েবল ঘোষণা, বৈকল্পিক না
- লুপে, লুপের বাইরে কোডটি সরান যা লুপিং পরিবর্তনশীলের জন্য বৈকল্পিক

উদাহরণস্বরূপ, আপনি যে তথ্যটি অনুলিপি করেন সেটি ল্যাপটপের সংখ্যা যা আপনি মুদ্রণ করতে চান তার উপর অনুরুপ। সুতরাং, আপনি শুধুমাত্র একবার (ক্লিপবোর্ডে) ডেটা অনুলিপি করুন এবং এটি একাধিকবার পুনঃব্যবহার করুন।

যদি আপনি আমার কোড পরামর্শটি সন্ধান করেন তবে আপনি দেখতে পাবেন যে আমি সম্পূর্ণরূপে নিয়মগুলি অনুসরণ করি নি; আপনি পরিবর্তনশীল জন্য সঠিক টাইপ উল্লেখ করা উচিত oLabels।

তারপর ব্যবহার করার সময় ত্রুটি একটি ভাল লুকানো উৎস ছিল date_tabela = Cells(i, 4).Value। Cells এখানে প্রসঙ্গে নির্ভরশীল। আমি এটা দিয়ে প্রতিস্থাপিত হয়েছে .Cells যা প্রসঙ্গ হিসাবে সংজ্ঞায়িত করে Worksheet("Program")।

রিসেট করা CutCopyMode নিছক প্রসাধনী হয়, আপনি শেষে শুধুমাত্র একবার এটি করতে পারেন।

কোড এখন এই মত দেখাচ্ছে:

Sub print_doses()
    Dim i As Integer, iLastRow As Integer
    Dim date1 As Date, date2 As Date
    Dim oLastRow As ListRow
    Dim srcRow As Range
    Dim date_tabela As Date
    Dim d As Integer, ile_dawek As Integer
    Dim oLabels

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.StatusBar = False
    Application.EnableEvents = False
    ActiveSheet.DisplayPageBreaks = False

    Set oLabels = Worksheets("Etykiety").ListObjects("Etykiety_druk").ListRows
    With Worksheets("Program")
        date1 = .Range("E2")
        date2 = .Range("E3")
        iLastRow = .ListObjects("Program").ListRows.Count + 6
        For i = 7 To iLastRow
            date_tabela = .Cells(i, 4).Value
            If date_tabela >= date1 And date_tabela <= date2 Then
                ile_dawek = .Cells(i, 11).Value
                Set srcRow = .ListObjects("Program").Range.Range(Cells(i - 5, 1), Cells(i - 5, 36))
                srcRow.Copy
                For d = 1 To ile_dawek
                    Set oLastRow = oLabels.Add()
                    oLastRow.Range.PasteSpecial xlPasteValuesAndNumberFormats
                Next
            End If
        Next i
        Application.CutCopyMode = False
    End With

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.StatusBar = ""
    Application.EnableEvents = True
    ActiveWorkbook.Save
End Sub