VBA için UDF

Excel'de Kullanım İçin Hazırladığımız UDF'lerden Başka VBA Prosedürleri

Excel'de kullanım için hazırladığımız UDF'lerden başka VBA prosedürleri içinde çalışıp bir sonuç döndüren fonksiyonlar da vardır. Bunlar da tıpkı VBA'in yerel fonksiyonları gibidirler. Genelde belirli bir (bazen birkaç) sonuç döndürmek üzere hazırlanırlar. Ender olarak bazı kaynaklarda sonuç döndürmeyen versiyonların kullanıldığını da görebilirsiniz ama bence bu tamamen yanlış kullanımdır. Sonuç döndürmeyen bir iş istiyorsak bunu Function olarak değil Sub olarak hazırlamalıyız.

Aşağıda bu yanlış kullanıma bir örnek bulunmaktadır. Bu, doğru çalışan tamamen düzgün bir koddur, ancak dediğim gibi Functionların amacı bu değildir, olmamalıdır.

                        
                            Sub YanlışFuncOrnek()
                                Call YanlışFunc
                            End Sub

                            Function YanlışFunc()
                                [A1] = 12
                            End Function

Fonksiyonların Amacı

Fonksiyonların amacı nedir diyecek olursak, iki temel amacı vardır:

Ana Sub prosedürünüzün çok uzaması durumunda bunu belli yerlerde kesip fonksiyon olarak yazmak ve ana koddan bu fonksiyonu çağırmak.
Belirli bir işi farklı zamanlarda, farklı kodlar içinde sürekli yapmak durumunda kalıyorsanız, bunu bir kez fonksiyon olarak yazarsınız, sonra her yerden bu fonksiyonu çağırırsınız. Böylece gereksiz tekrardan kurtulmuş olursunuz. Üstelik fonksiyonda küçük bir değişiklik gerekse bile sadece bir kere yapılması yeterli olacaktır.

Son olarak belirtmek istediğim bir husus var, VBA kullanımı için yazdığımız functionlara genelde kimse UDF demez, UDF denince akla genelde Excel için yazdığımız UDF'ler gelir, ama aslında teknik olarak bakıldığında VBA içi kullanım amacıyla yazdığımız functionlar da UDF'tir. Zira VBA'de yerel olarak gelmediği için biz bunları kendimiz tanımlarız.

Tanımlama

Bunların tanımlanması da tıpkı Excel UDF tanımı gibidir.

                        
                        Function fonksiyonadı(Parametre1 As datatipi, ...) As DönüşTipi
                            .......
                        End Function

Aşağıda bu yanlış kullanıma bir örnek bulunmaktadır. Bu, doğru çalışan tamamen düzgün bir koddur, ancak dediğim gibi Functionların amacı bu değildir, olmamalıdır.

                        
                            Sub YanlışFuncOrnek()
                                Call YanlışFunc
                            End Sub

                            Function YanlışFunc()
                                [A1] = 12
                            End Function

Fonksiyonların Amacı

Fonksiyonların amacı nedir diyecek olursak, iki temel amacı vardır:

Ana Sub prosedürünüzün çok uzaması durumunda bunu belli yerlerde kesip fonksiyon olarak yazmak ve ana koddan bu fonksiyonu çağırmak.
Belirli bir işi farklı zamanlarda, farklı kodlar içinde sürekli yapmak durumunda kalıyorsanız, bunu bir kez fonksiyon olarak yazarsınız, sonra her yerden bu fonksiyonu çağırırsınız. Böylece gereksiz tekrardan kurtulmuş olursunuz. Üstelik fonksiyonda küçük bir değişiklik gerekse bile sadece bir kere yapılması yeterli olacaktır.

Tanımlama

Bunların tanımlanması da tıpkı Excel UDF tanımı gibidir.

                        
                            Function fonksiyonadı(Parametre1 As datatipi, ...) As DönüşTipi
                                .......
                            End Function

Kullanım

Şimdi bir örnekle konuyu pekiştirelim.

Diyelim ki ana makronuzda (veya birçok makronuzda) öyle bir yer geliyor ki, o anda ilgili alanda filtre uygulanmış mı uygulanmamış mı bunu kontrol etmek ve sonrasında duruma göre de bir işlem yaparak ilerlemek istiyorsunuz. Bunun için aşağıdaki gibi bir Function yazarız. Bunu Personal.xlsb içine yazıyorum.

                        
                            Function filter_kontrol(ws As Worksheet) As Byte
                                If ws.AutoFilterMode = True Then
                                    If ws.FilterMode = False Then
                                        filter_kontrol = 1 'filtre açık ama kriter yok
                                    Else
                                        filter_kontrol = 2 'filtre açık ve kriter var
                                    End If
                                Else
                                    filter_kontrol = 0
                                End If
                            End Function

                            Sub filtrekullan()
                                'örnek kullanım şekli
                                If Application.Run("PERSONAL.xlsb!filter_kontrol", ActiveSheet) = 2 Then 'filtre açık ve kriter var
                                    ActiveSheet.ShowAllData
                                ElseIf Application.Run("PERSONAL.xlsb!filter_kontrol", ActiveSheet) = 0 Then 'filtre uygulanmamış
                                    Selection.AutoFilter
                                'diğer durumlarda yani 1, yani filtre açık ama kriter yok, bir şey yapmaya gerek yok
                                End If
                            End Sub

Dönüş Değeri

Genelde fonksiyonların sadece bir adet dönüş değeri olur. Ancak bazen bir fonksiyonu çağırdığımızda birden fazla dönüş değeri isteyebiliriz. Bunun için çeşitli alternatifler olmakla birlikte ben ikisinden bahsedeceğim. Aslında ikisinden de farklı yerlerde bahsetmiştik. O yüzden sadece link veriyor olacağım.

ByRef ile çoklu değer döndürme
Diziler ve Collectionlar aracılığı ile çoklu değer döndürme

Konuyu tamamlamak adına İleri Terminoloji sayfasındaki Argüman ve Parametre ile Prosedürlere Erişim maddelerini gözden geçirmenizi tavsiye ederim.

Yinelemeli (Recursive) Fonksiyonlar

Bir fonksiyonun içinde kendisine başvuru yapmamız da mümkündür. Buna recursive başvuru denir. Tabi bunu sonsuza kadar değil de belirli bir şart sağlanana (mesela bir limite ulaşmak gibi) kadar kurgulamak gerekir, yoksa kodumuz kısır döngüye girer.

Recursive fonksiyonlara klasik örnek matematikteki faktoriyel hesabıdır. Aşağıdaki örnekte bu hesabı bulabilirsiniz. Aldığı parametre 1 olana kadar kendisini -1 değeriyle çağırıp parametre ile çarpıyor. Parametrenin değeri 1'e ulaştığında (indiğinde) yineleme sonlanmış oluyor.

                        
                                Function faktoriyel(ByVal n As Integer) As Integer
                                    If n <= 1 Then
                                        faktoriyel = 1
                                    Else
                                        faktoriyel = faktoriyel(n - 1) * n
                                    End If
                                End Function

                                Sub faktoriyel_yaz()
                                    Debug.Print faktoriyel(5) '120
                                End Sub

Recursive Fonksiyonun Ele Alınışı

Bu fonksiyonun ele alınışı aşama aşama şöyledir:

Önce 5 parametresini verdik, sonuç = faktoriyel(4) * 5
Şimdi parametre olarak 4 gitmiş oldu, sonuç = faktoriyel(3) * 4 * 5 (Koyu kısım aslında bir üst satırın açılmış hali)
Sonra 3 gider, sonuç = faktoriyel(2) * 3 * 4 * 5 (Koyu kısım yine bir üsttekinin açılımı)
Sonra 2, sonuç = faktoriyel(1) * 2 * 3 * 4 * 5
Son olarak 1 gider, sonuç = faktoriyel(1) * 2 * 3 * 4 * 5
Nihai sonuç = 1 * 2 * 3 * 4 * 5 = 120

Bunun dışında parent-child tarzı oluşumlarda (Ör: klasör-dosya veya HTML tag'i ve alt tag'i) da çok sık kullanılır. Bu kullanım şekline bir örnek de aşağıda bulunmaktadır.

                        
                                'ana prosedür
                                Sub recursive_fulldosya()
                                    Dim fso As New Scripting.FileSystemObject
                                    Dim anaklasorStr As String
                                    anaklasorStr = "C:\windows"
                                    Recursiveİlerle fso.GetFolder(anaklasorStr)
                                End Sub

                                'recursive prosedür
                                Sub Recursiveİlerle(kls As Variant) 'variant çünkü ilk girereken Folder sonra Folders olacak
                                    Dim altKlasorler As Variant
                                    Dim dosya As file
                                    Dim i As Integer

                                    On Error Resume Next 'erişim izni olmayan yerlerde hata almasın diye
                                    For Each altKlasorler In kls.SubFolders
                                        Recursiveİlerle altKlasorler 'burada recursive olarak başvuru var
                                    Next
                                    i = 1

                                    For Each dosya In kls.Files
                                        ActiveCell(i, 1).Value = dosya.ParentFolder
                                        ActiveCell(i, 1).Offset(0, 1).Value = dosya.Name
                                        ActiveCell(i, 1).Offset(0, 2).Value = dosya.Size
                                        i = i + 1
                                    Next
                                End Sub

Excel Hücre Grubunu Mail Body'sine Koymak

Bir başka örnek de meşhur Ron de Bruin'in belirli bir Excel hücre grubunu mail body’si haline getiren fonksiyondur, efsanedir, hayat kurtarıcıdır. Kod aşağıdaki gibi olup orijinaline buradan ulaşabilirsiniz.

                        
                            Function RangetoHTML(rng As Range)
                                ' Changed by Ron de Bruin 28-Oct-2006
                                ' Working in Office 2000-2013
                                Dim fso As Object
                                Dim ts As Object
                                Dim TempFile As String
                                Dim TempWB As Workbook

                                TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

                                'Copy the range and create a new workbook to paste the data in
                                rng.Copy
                                Set TempWB = Workbooks.Add(1)
                                With TempWB.Sheets(1)
                                    .Cells(1).PasteSpecial Paste:=8
                                    .Cells(1).PasteSpecial xlPasteValues, , False, False
                                    .Cells(1).PasteSpecial xlPasteFormats, , False, False
                                    .Cells(1).Select
                                    Application.CutCopyMode = False
                                    On Error Resume Next
                                    .DrawingObjects.Visible = True
                                    .DrawingObjects.Delete
                                    On Error GoTo 0
                                End With

                                'Publish the sheet to a htm file
                                With TempWB.PublishObjects.Add( _
                                     SourceType:=xlSourceRange, _
                                     Filename:=TempFile, _
                                     Sheet:=TempWB.Sheets(1).Name, _
                                     Source:=TempWB.Sheets(1).UsedRange.Address, _
                                     HtmlType:=xlHtmlStatic)
                                    .Publish (True)
                                End With

                                'Read all data from the htm file into RangetoHTML
                                Set fso = CreateObject("Scripting.FileSystemObject")
                                Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
                                RangetoHTML = ts.ReadAll
                                ts.Close
                                RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                                                      "align=left x:publishsource=")

                                'Close TempWB
                                TempWB.Close savechanges:=False

                                'Delete the htm file we used in this function
                                Kill TempFile

                                Set ts = Nothing
                                Set fso = Nothing
                                Set TempWB = Nothing
                            End Function

Örnek kullanımı ise şöyledir. Uzun olmaması adına tüm kodu buraya koymadım, tam örnek koda Outlook programlama bölümünde değineceğiz.

                        
                                ....
                                Set rng = Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
                                ....
                                ....
                                .htmlbody = "Değerli MİY'imiz," & Chr(14) & Chr(14)
                                .....
                                .....
                                .htmlbody = .htmlbody + Application.Run("PERSONAL.xlsb!RangetoHTML", rng) & vbCrLf & Chr(14)
                                .......

İlk Visible Alan ve Sonrasını Seçmek

Belirli bir hücre aralığında ilk görünen hücreyi ve sonrasını seçmek için aşağıdaki VBA fonksiyonlarını kullanabilirsiniz:

                        
                            Function ilkvisiblesec(erim As Range) As Range
                                Set ilkvisiblesec = erim.Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1)
                            End Function

                            Function ilkvisiblesonrasıalansec(erim As Range) As Range
                                Dim ilk As Range
                                Dim son As Range
                                Dim n As Integer, r As Integer

                                n = erim.Columns.Count
                                r = erim.SpecialCells(xlCellTypeVisible).Cells.Count / n - 1 'tek satırlık bir alan olup olmadığını kontrol etmek için

                                Set ilk = erim.Offset(1, 0).Resize(erim.Rows.Count - 1, 1).SpecialCells(xlCellTypeVisible).Cells(1, 1) 'bu kısım ilk görünen hücreyi verir
                                Set son = ilk.Offset(0, n - 1)
                                Set ilktoright = Range(ilk, son)

                                If r > 2 Then
                                    Set ilkvisiblesonrasıalansec = Range(ilktoright, ilktoright.End(xlDown))
                                Else
                                    Set ilkvisiblesonrasıalansec = ilktoright
                                End If
                            End Function