Saya menulis sebuah fungsi di VBA dan telah menyediakan versi yang disederhanakan di bawah ini. Pada dasarnya, dibutuhkan argumen, membentuk sebelumnya vlookuppada rentang bernama dalam lembar menggunakan nilai argumen, meneruskan nilai vlookedup ke fungsi lain, dan akhirnya mengembalikan hasilnya.

Saya menggunakan fungsi ini banyak .. seperti 50.000 kali di buku kerja saya. Akibatnya, buku kerja saya cukup lambat untuk dihitung.

Apakah ada beberapa perubahan sederhana yang dapat saya lakukan pada fungsi ini untuk mengoptimalkannya untuk kecepatan?

Keterbacaan bukan masalah, saya hanya ingin membuat hal ini berjalan lebih cepat. Kode harus tetap di VBA.

Public Function Yield(Name As String, Price As Double)
    Dim DDate As Double
    Dim ConversionFactor As Double
    DDate = Application.WorksheetFunction.VLookup(Name, Range("LookupRange"), 3, 0)
ConversionFactor = Application.WorksheetFunction.VLookup(Name, Range("LookupRange"), 7, 0)
Yield = 100 * Application.Run("otherCustomFunction",DDate,ConversionFactor,Price)
End Function

Strategi pertama: optimalkan fungsi itu sendiri

Seharusnya menggandakan kecepatan

Public Function Yield(Name As String, Price As Double)
    Dim Lookup As Range, rw As Integer
    Set Lookup = Range("LookupRange")
    rw = Application.WorksheetFunction.Match(Name, Lookup.Resize(ColumnSize:=1), 0)

    Yield = 100 * Application.Run("otherCustomFunction", Lookup.Cells(rw, 3), Lookup.Cells(rw, 7), Price)
End Function

Ini karena Anda hanya mencari rentang dengan nama "LookupRange" sekali bukan dua kali dan Anda hanya mencari garis yang tepat satu kali, bukan dua kali.

Strategi kedua: ambil rentang hanya sekali di muka

Mungkin 4 kali lebih cepat

Jika kita mengambil rentang dalam kode yang menggunakan yieldfungsi, kita hanya perlu melakukannya sekali

Public Function Yield(Lookup As Range, Name As String, Price As Double)
    rw = Application.WorksheetFunction.Match(Name, Lookup.Resize(ColumnSize:=1), 0)

    Yield = 100 * Application.Run("otherCustomFunction", Lookup.Cells(rw, 3), Lookup.Cells(rw, 7), Price)
End Function

Public Sub CallingRoutine()
    Dim Lookup As Range, rw As Integer
    Set Lookup = Range("LookupRange")

    ' Some code

    For Each someItem In someSet
        Dim amount As Double, Name As String, Price As Double

        ' Some code to deter;ine name and price

        amount = Yield(Lookup, Name, Price)

        ' Some code that used the yield
    Next someThing
End Sub

Ada varian dari strategi ini di mana Anda menyatakan Pencarian di luar semua rutinitas, seperti yang saya lakukan dengan kamus di bawah ini ..

Strategi ketiga: Masukkan semua nilai yang relevan dalam kamus

Urutan besarnya lebih cepat jika Anda menelepon YieldSANGAT sering.

• Anda mencari rentang bernama
• Anda meminta semua nilai dari excel sekaligus
• Anda mencari Names dalam kamus, yang jauh lebih efisien daripada mencari dalam kisaran

Ini kodenya:

Public Function Yield(Name As String, Price As Double)
    If LookDict Is Nothing Then
        Set LookDict = New Dictionary

        Dim LookVal As Variant, rw As Integer, ToUse As ToUseType
        LookVal = Range("LookupRange").Value

        For rw = LBound(LookVal, 1) To UBound(LookVal, 1)
            Set ToUse = New ToUseType
            ToUse.Row3Val = LookVal(rw, 3)
            ToUse.Row7Val = LookVal(rw, 7)
            LookDict.Add LookVal(rw, 1), ToUse
        Next rw
    End If

    Set ToUse = LookDict.Item(Name)
    Yield = 100 * Application.Run("otherCustomFunction", _
                  ToUse.Row3Val, ToUse.Row7Val, Price)
End Function

Public Sub CallingRoutine()
    ' Some code

    For Each someItem In someSet
        Dim amount As Double, Name As String, Price As Double

        ' Some code to deter;ine name and price

        amount = Yield(Name, Price)

        ' Some code that used the yield
    Next someThing
End Sub

Beberapa hal yang akan saya lakukan -

Option Explicit

Public Function Yield(ByVal lookupName As String, ByVal price As Double)
    Dim dDate As Double
    Dim conversionFactor As Double
    Dim foundRow As Long
    foundRow = Application.WorksheetFunction.Match(lookupName, Range("LookupRange"))
    dDate = Range("lookuprange").Cells(foundRow, 3)
    converstionfactor = Range("LookupRange").Cells(foundRow, 7)
    Yield = 100 * otherCustomFunction(dDate, conversionFactor, price)
End Function

Ketika Anda melewati argumen Anda, secara default, berikan mereka ByRef yang lebih lambat dari ByVal dan melihat bagaimana Anda tidak perlu referensi, hanya berikan saja ByVal.

Saya tidak yakin matchjauh lebih cepat daripada vlookuptetapi dengan menggunakan matchAnda memotong proses Anda setengah dan hanya referensi baris yang Anda butuhkan.

Saya juga mengonversi variabel ke nama konvensi penamaan VBA Standar .

Anda juga tidak perlu Application.rununtuk memanggil makro Anda. Pastikan itu juga melewati argumen ByVal