Bu siteye giriş yaparak Çerez kullanımını kabul etmiş oluyorsunuz. İşbu sitede; çerez olarak, sadece son giriş tarihiniz ve eğer üye olursanız oturum statünüz tutulacaktır. Bunlar dışında başka hiçbir bilgi tutulmamaktadır. Çerezler için detaylı bilgi için buraya tıklayınız.
ANLADIM

DUYURULAR

Yeni eklenen ve/veya güncellenen sayfaları görmek için buraya tıklayınız.

Güncel ödev ve test listesini görmek için buraya tıklayınız.

Sitede yapılan iyileştirmeAer ve hata düzeltmelerine ait tüm bilgilendirmeleri görmek içinburaya tıklayınız.

Baş
Udemy
Konular
Son
Konular
VBAicinUDF
Fonksiyonlar
VBAMakro
VBAMakroFonksiyonlar6

VBA için UDF

Giriş

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ödürmeyen versiyonların kullanıldığını da görebilirsiniz ama bence bu tamamen yanış 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ı 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
  • Bir diğeri de, 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şklik 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ı(Pamaratre1 As datatipi,...) As DönüşTipi
.......
End Function

Sadece kullanırken Excel içinde değil de VBA içinde kullanıyoruz. Bu arada Excel'den böyle bir fonksiyonu yazmaya çalıştığınızda yazabilirsiniz, buna bi engel yoktur. O yüzden bunların görünmesini istemiyorsanız Private olarak tanımlamanız gerekir. Aşağıdaki örneklerden bunu görebilirsiniz.

Aşağıda görüldüğü üzere Excelde bir hücreye =UDF yazınca sadece UDFExcel çıktı.

Tabi ilgili fonksiyonu Private tanımlamanın da bir dezavanatajı var, onu prosedürlerin erişim seviyesi bölümünde görmüştük. Özetle bu fonksiyonlara sadece bulunduğu modülden erişilebilir. Eğer bu bir sıkıntı olmayacaksa private tanımlayın, sıkıntı olacaksa public tanımlayın. (Tabi bu arada bunları bir Add-in içine yazdığınız senaryoya göre söylüyorum. Add-in dışında başka bir yere mesela Personal.xlsb içine yazılanlarda zaten fonksiyon ismini Excele yazınca hemen çıkmıyordu, başında Personal.xlsb! olması gerekiyordu veya Insert function diyip seçmek gerekiyordu)

Zaten genel tavsiyem şudur: Özellikle Excel UDF'lerinizi başkalarına da dağıtıyorsanız UDF.xlam dosyası içine sadece Excel UDFlerini koyun, kendi kullanımınız için oluşturduğunuz VBA UDF'lerini ise Personal.xlsb içine koyun.

Kullanım

Şimdi bir örnekle konuyu pekiştirelim.

Diyelimki 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 yazdı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 criter yok
    Else
        filter_kontrol = 2 'filtre açık ve criter 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 criter var
        ActiveSheet.ShowAllData
    ElseIf Application.Run("PERSONAL.xlsb!filter_kontrol", ActiveSheet) = 0 Then 'filtre uygulanmamış
        Selection.AutoFilter
    'diğer duurmlarda yani 1, yani filtre açık ama criter yok, biş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 bahsedceğim. Aslında ikisinden de farklı yerlede bahsetmiştiK. O yüzden sadece link veriyor olacağım.

Konuyu tamamlamak adına İleriTerminoloji 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		

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. (Dosya ve klasörlerle çalışmak için buraya tıklayınız)

'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	

Çeşitli Örnekler

Excel hücre grubunu mail body'sine koymak

Bir başka örnek de meşhur RonDeBruin'in belirli bir Excel hücre grubunu mail bodysi haline getiren fonksiyondur, efsanedir, hayat kurtarıcıdır. Kod aşağıdaki gibi olup orjinaline 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 past 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

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

TEST SORULARI

Son Sorumuz şuymuş:Bir metindeki tüm noktaları yoketmek istiyorsunuz. Hangi fonksiyonu kullanırdınız?
Soru:

A şıkkı:

B şıkkı:

C şıkkı:

D şıkkı:

Doğru Cevap Etiketler

İlişkili konuyu seç

274475

Label
* Sorulara verilen yanlış cevaplardaki esprili yorumlarım için hoşgörünüze sığınıyorum.
* Test ve Ödevlerdeki bazı detaylar burada anlatılmamış olabilir. Bunları kendiniz araştırıp bulmalısınız.
* Birden çok konuya ait içeriği olan ödevler var. Algoritmik açıdan bakıldığında o an en uygun konuya adreslenmiştir.
Dikkat! Bir soruya cevap verdikten sonra geri dönemezsiniz.
0
0
0
0

SoruID:... Şu an için bu konu için soru bulunmamaktadır. İletişim menüsünden örnek sorularınızı bana iletebilirsiniz.




ÖDEVLER

6
0
Ödev No:36. Bir metnin başından veya sonundan belirli bir miktar karakteri kırpan bir fonksiyon yazın. Başından veya sonundan bilgisi için vereceğiniz parametre tek olsun ve default değeri "sondan" olsun. Test senaryo: Duruma göre "volkan;meltem;doruk;doğa;" şeklinde, duruma göre ";volkan;meltem;doruk;doğa" şeklinde birleştirilmiş isimlerden oluşan metnin son/ilk karakterini uçurun.
Çözüme bakın(Başka türlü de çözülebilir tabi, bu benim çözümüm.)

Function metnikırp(ByVal metin As String, ByVal kaç As Byte, Optional sondanmı As Boolean = True) As String
    If sondanmı = True Then
        metnikırp = Left(metin, Len(metin) - kaç)
    Else
        metnikırp = Mid(metin, kaç + 1)
    End If
End Function
    Sub metnikırp_test()
        birleşik1 = "volkan;meltem;doruk;doğa;"
        birleşik2 = ";volkan;meltem;doruk;doğa"
        
        Debug.Print metnikırp(birleşik1, 1)
        Debug.Print metnikırp(birleşik2, 1, False)
    End Sub



=YORUMLAR ve SORULAR=


DEVİR UYARISI

Herkese merhaba. Hosting maliyetlerinin aşırı artması yüzünden sitemi yakın zamanda(en geç Mayıs 2023) kapatmaya karar vermiştim. Ancak, siteyi yakından takip eden bir arkadaş siteyi devralmak istemiştir. Siteyi, Mayıs ayında kendisine devir etmeye karar verdim. Üyelik bilgilerini bana güvenerek girdiğiniz için, hepsini silmiş bulunuyorum, yani mail adreslerinizi kimseyle paylaşmamış olacağım. Bilginizi rica ederim.