Çözüldü 365 Versiyonlarında ki Formülleri Udf Yapmak

arzuhalci' Alıntı:

Excel'in 365 sürümünde kullanılan bazı yeni işlevler eski sürümlerde yer almadığı için, bu işlevlerin benzerlerini eski sürümlerde UDF (User Defined Functions) kullanarak yazmak mümkün olabilir. Ancak, her bir işlevin detaylarına göre yazılacak UDF'ler değişir.


Aşağıda, verdiğiniz bazı Excel 365 işlevlerinin eski sürümlerde UDF olarak nasıl yazılabileceğine dair genel bir yaklaşım bulunmaktadır

1. AL

Bu işlev, belirli bir veri aralığından ilk değeri döndüren bir işlevdir. Eski sürümlerde bunun benzerini aşağıdaki gibi yazabiliriz:

Function AL(rng As Range) As Variant
AL = rng.Cells(1, 1).Value
End Function

2. ARALIKBİRLEŞTİR

Bir hücre aralığındaki değerleri birleştirir. Bu işlevin yerine bir UDF yazabiliriz:

Function AralikBirlestir(rng As Range) As String
Dim cell As Range
Dim result As String
result = ""
For Each cell In rng
result = result & cell.Value & " "
Next cell
AralikBirlestir = Trim(result)
End Function

3. BENZERSİZ

Verilen bir aralıktaki benzersiz değerleri döndürmek için bir UDF:

Function Benzersiz(rng As Range) As Variant
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim cell As Range
For Each cell In rng
If Not dict.exists(cell.Value) Then
dict.Add cell.Value, Nothing
End If
Next cell
Benzersiz = dict.Keys
End Function

4. ÇAPRAZARA

Bu işlevi, iki diziyi çapraz bir şekilde karşılaştırmak için aşağıdaki gibi yazabiliriz. Ancak, çaprazlaştırma için daha fazla detaya ihtiyaç var.

Function CaprazAra(rng1 As Range, rng2 As Range) As Variant
Dim i As Long, j As Long
Dim result As Variant
ReDim result(1 To rng1.Rows.Count, 1 To rng2.Columns.Count)
For i = 1 To rng1.Rows.Count
For j = 1 To rng2.Columns.Count
result(i, j) = rng1.Cells(i, 1).Value * rng2.Cells(1, j).Value ' Örnek işlem
Next j
Next i
CaprazAra = result
End Function

5. DİZİMETİN

Dizi içindeki metinleri birleştirmek için bir UDF yazılabilir:

Function DiziMetin(rng As Range) As String
Dim cell As Range
Dim result As String
For Each cell In rng
If Len(cell.Value) > 0 Then
result = result & cell.Value & ", "
End If
Next cell
DiziMetin = Left(result, Len(result) - 2) ' Son virgülü kaldırır
End Function

6. FİLTRE

Bir aralıktaki verileri filtrelemek için VBA kullanarak benzer bir işlev yazabiliriz:

Function Filtre(rng As Range, kriter As Variant) As Variant
Dim output() As Variant
Dim i As Long, j As Long, count As Long
count = 0
For i = 1 To rng.Rows.Count
If rng.Cells(i, 1).Value = kriter Then
count = count + 1
End If
Next i

If count > 0 Then
ReDim output(1 To count)
count = 0

For i = 1 To rng.Rows.Count
If rng.Cells(i, 1).Value = kriter Then
count = count + 1
output(count) = rng.Cells(i, 1).Value

End If
Next i
End If
Filtre = output
End Function

7. SIRALA

Verilen veriyi sıralamak için:

Function Sirala(rng As Range) As Variant
Dim arr() As Variant
arr = rng.Value
Dim i As Long, j As Long
Dim temp As Variant
For i = 1 To UBound(arr, 1) - 1
For j = i + 1 To UBound(arr, 1)
If arr(i, 1) > arr(j, 1) Then
temp = arr(i, 1)
arr(i, 1) = arr(j, 1)
arr(j, 1) = temp
End If
Next j
Next i
Sirala = arr
End Function

8. YATAYYIĞ

Yatay yönlü bir dizi oluşturmak için aşağıdaki gibi bir UDF yazılabilir:

Function YatayYig(rng As Range) As Variant
Dim result() As Variant
Dim i As Long
ReDim result(1 To 1, 1 To rng.Cells.Count)
For i = 1 To rng.Cells.Count
result(1, i) = rng.Cells(i).Value
Next i
YatayYig = result
End Function

Genel Notlar:

UDF’ler VBA (Visual Basic for Applications) kodu kullanılarak yazılır.
Her işlevin amacı ve içeriği doğrultusunda daha karmaşık hesaplamalar yapılabilir.
Bu örneklerde kullanılan işlevler, temel işlevsellik sağlar, ancak daha detaylı ve özgün işlevsellik için formüllerin kesin işleyişine göre daha fazla detay eklemek gerekebilir.

Genişletmek için tıkla...

kralım' Alıntı:

Function UDF365(FunctionName As String, ParamArray args() As Variant) As Variant
Select Case UCase(FunctionName)
Case "AL"
UDF365 = Left(CStr(args(0)), args(1))

Case "BENZERSİZ"
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
Dim i As Long
For i = LBound(args(0)) To UBound(args(0))
If Not dict.exists(args(0)(i, 1)) Then
dict.Add args(0)(i, 1), Nothing
End If
Next i
Dim arr() As Variant
ReDim arr(1 To dict.Count, 1 To 1)
i = 1
Dim key
For Each key In dict.keys
arr(i, 1) = key
i = i + 1
Next key
UDF365 = arr

Case "FİLTRE"
Dim criteria As Variant
criteria = args(1)
Dim result() As Variant
Dim source As Variant
source = args(0)
Dim r As Long, c As Long, ri As Long
ReDim result(1 To UBound(source, 1), 1 To UBound(source, 2))
ri = 1
For r = 1 To UBound(source, 1)
If source(r, 1) = criteria Then
For c = 1 To UBound(source, 2)
result(ri, c) = source(r, c)
Next c
ri = ri + 1
End If
Next r
ReDim Preserve result(1 To ri - 1, 1 To UBound(source, 2))
UDF365 = result

Case "ÇOKEĞER"
' args(0) = koşullar dizisi, args(1) = değerler dizisi
Dim sum As Double
sum = 0
For i = LBound(args(0)) To UBound(args(0))
If args(0)(i, 1) Then
sum = sum + args(1)(i, 1)
End If
Next i
UDF365 = sum

Case "DÜŞEYYIĞ"
Dim outArr() As Variant
Dim src As Variant
src = args(0)
Dim rowCount As Long
rowCount = UBound(src, 1)
ReDim outArr(1 To rowCount, 1 To 1)
For i = 1 To rowCount
outArr(i, 1) = src(i, 1)
Next i
UDF365 = outArr

Case Else
UDF365 = "Tanımsız fonksiyon: " & FunctionName
End Select
End Function


_________________________
Excel 365 fonksiyonlarını eski sürümlerde simüle etmeni sağlar.
Tümünü tek bir fonksiyon içinde topladığı için dosya içinde fazla sayıda UDF olmasına gerek kalmaz.
İleride yeni fonksiyonlar da bu yapıya kolayca eklenebilir.

Genişletmek için tıkla...

kralım' Alıntı:

Ayrı ayrı

' AL Fonksiyonu Benzeri
Function UDF_AL(hücre As Range) As String
UDF_AL = hücre.Address(False, False)
End Function

' ARALIKBİRLEŞTİR Fonksiyonu Benzeri
Function UDF_ARALIKBİRLEŞTİR(ayraç As String, yokSayBoş As Boolean, ParamArray aralıklar() As Variant) As String
Dim Sonuc As String
Dim Alan As Variant
Dim Hücre As Range

Sonuc = ""
For Each Alan In aralıklar
If TypeOf Alan Is Range Then
For Each Hücre In Alan
If Not yokSayBoş Or Hücre.Value <> "" Then
If Sonuc <> "" Then Sonuc = Sonuc & ayraç
Sonuc = Sonuc & Hücre.Value
End If
Next Hücre
ElseIf Not yokSayBoş Or Alan <> "" Then
If Sonuc <> "" Then Sonuc = Sonuc & ayraç
Sonuc = Sonuc & Alan
End If
Next Alan
UDF_ARALIKBİRLEŞTİR = Sonuc
End Function

' BENZERSİZ Fonksiyonu Benzeri
Function UDF_BENZERSİZ(aralık As Range) As Variant
Dim Koleksiyon As New Collection
Dim Hücre As Range
Dim Anahtar As String
Dim SonuçDizisi() As Variant
Dim i As Long

On Error Resume Next
For Each Hücre In aralık
Anahtar = CStr(Hücre.Value)
Koleksiyon.Add Hücre.Value, Anahtar
Next Hücre
On Error GoTo 0

ReDim SonuçDizisi(1 To Koleksiyon.Count, 1 To 1)
i = 1
For Each Anahtar In Koleksiyon
SonuçDizisi(i, 1) = Koleksiyon(Anahtar)
i = i + 1
Next Anahtar
UDF_BENZERSİZ = SonuçDizisi
End Function

' ÇAPRAZARA Fonksiyonu Benzeri (Basit Yaklaşım - Tam işlevsellik için daha karmaşık bir UDF gerekebilir)
Function UDF_ÇAPRAZARA(satır_dizisi As Range, sütun_dizisi As Range, veri_dizisi As Range, satır_eşleşme As Variant, sütun_eşleşme As Variant, [yoksa_değer]) As Variant
Dim r As Long, c As Long
Dim satırBulundu As Boolean, sütunBulundu As Boolean
Dim sonuç As Variant

sonuç = yoksa_değer

For r = 1 To satır_dizisi.Rows.Count
If satır_dizisi.Cells(r, 1).Value = satır_eşleşme Then
satırBulundu = True
Exit For
End If
Next r

For c = 1 To sütun_dizisi.Columns.Count
If sütun_dizisi.Cells(1, c).Value = sütun_eşleşme Then
sütunBulundu = True
Exit For
End If
Next c

If satırBulundu And sütunBulundu Then
If r <= veri_dizisi.Rows.Count And c <= veri_dizisi.Columns.Count Then
sonuç = veri_dizisi.Cells(r, c).Value
End If
End If

UDF_ÇAPRAZARA = sonuç
End Function

' ÇAPRAZEŞLEŞTİR Fonksiyonu Benzeri (Basit Yaklaşım - Tam işlevsellik için daha karmaşık bir UDF gerekebilir)
Function UDF_ÇAPRAZEŞLEŞTİR(satır_eşleşme_değeri As Variant, satır_dizisi As Range, sütun_eşleşme_değeri As Variant, sütun_dizisi As Range, [eşleşme_türü_satır], [eşleşme_türü_sütun], [yoksa_değer]) As Variant
Dim satır_konumu As Variant
Dim sütun_konumu As Variant

satır_konumu = Application.Match(satır_eşleşme_değeri, satır_dizisi, IIf(IsMissing(eşleşme_türü_satır), 0, eşleşme_türü_satır))
sütun_konumu = Application.Match(sütun_eşleşme_değeri, sütun_dizisi, IIf(IsMissing(eşleşme_türü_sütun), 0, eşleşme_türü_sütun))

If IsError(satır_konumu) Or IsError(sütun_konumu) Then
UDF_ÇAPRAZEŞLEŞTİR = IIf(IsMissing(yoksa_değer), CVErr(xlErrNA), yoksa_değer)
Else
UDF_ÇAPRAZEŞLEŞTİR = Array(satır_konumu, sütun_konumu)
End If
End Function

' ÇOKEĞER Fonksiyonu Benzeri
Function UDF_ÇOKEĞER(ParamArray koşullar() As Variant) As Variant
Dim i As Long

If UBound(koşullar) Mod 2 <> 1 Then
UDF_ÇOKEĞER = CVErr(xlErrNA) ' Yanlış sayıda argüman
Exit Function
End If

For i = LBound(koşullar) To UBound(koşullar) Step 2
If koşullar(i) Then
UDF_ÇOKEĞER = koşullar(i + 1)
Exit Function
End If
Next i

' Eşleşme bulunamazsa (aksi belirtilmediyse) HATA döndürür
UDF_ÇOKEĞER = CVErr(xlErrNA)
End Function

' DEĞERMETİN Fonksiyonu Benzeri
Function UDF_DEĞERMETİN(değer As Variant, [biçim_metni]) As String
If IsMissing(biçim_metni) Then
UDF_DEĞERMETİN = CStr(değer)
Else
UDF_DEĞERMETİN = Format(değer, biçim_metni)
End If
End Function

' DÜŞEYYIĞ Fonksiyonu Benzeri
Function UDF_DÜŞEYYIĞ(ParamArray aralıklar() As Variant) As Variant
Dim SonuçDizisi() As Variant
Dim Alan As Variant
Dim Hücre As Range
Dim ToplamSatır As Long
Dim SütunSayısı As Long
Dim MevcutSatır As Long
Dim i As Long, j As Long

' Toplam satır sayısını ve sütun sayısını hesapla
For Each Alan In aralıklar
If TypeOf Alan Is Range Then
ToplamSatır = ToplamSatır + Alan.Rows.Count
SütunSayısı = WorksheetFunction.Max(SütunSayısı, Alan.Columns.Count)
End If
Next Alan

If ToplamSatır = 0 Then Exit Function

ReDim SonuçDizisi(1 To ToplamSatır, 1 To SütunSayısı)
MevcutSatır = 1

For Each Alan In aralıklar
If TypeOf Alan Is Range Then
For i = 1 To Alan.Rows.Count
For j = 1 To Alan.Columns.Count
SonuçDizisi(MevcutSatır, j) = Alan.Cells(i, j).Value
Next j
MevcutSatır = MevcutSatır + 1
Next i
End If
Next Alan

UDF_DÜŞEYYIĞ = SonuçDizisi
End Function

' DİZİMETİN Fonksiyonu Benzeri
Function UDF_DİZİMETİN(dizi As Variant, [ayraç], [yoksay_boş]) As String
Dim Metinler As Collection
Dim Eleman As Variant
Dim Sonuc As String

Set Metinler = New Collection
On Error Resume Next
If IsArray(dizi) Then
For Each Eleman In dizi
If Not IsMissing(yoksay_boş) And yoksay_boş Then
If Eleman <> "" Then Metinler.Add CStr(Eleman)
Else
Metinler.Add CStr(Eleman)
End If
Next Eleman
ElseIf TypeOf dizi Is Range Then
For Each Eleman In dizi
If Not IsMissing(yoksay_boş) And yoksay_boş Then
If Eleman.Value <> "" Then Metinler.Add CStr(Eleman.Value)
Else
Metinler.Add CStr(Eleman.Value)
End If
Next Eleman
Else
If Not IsMissing(yoksay_boş) And yoksay_boş Then
If dizi <> "" Then Metinler.Add CStr(dizi)
Else
Metinler.Add CStr(dizi)
End If
End If
On Error GoTo 0

Sonuc = ""
Dim Metin As Variant
For Each Metin In Metinler
If Sonuc <> "" Then
If IsMissing(ayraç) Then
Sonuc = Sonuc & "," & Metin
Else
Sonuc = Sonuc & ayraç & Metin
End If
Else
Sonuc = Metin
End If
Next Metin

UDF_DİZİMETİN = Sonuc
End Function

' DİZİOLUŞTUR Fonksiyonu Benzeri
Function UDF_DİZİOLUŞTUR(satırlar As Long, sütunlar As Long, lambda_fonksiyon As String) As Variant
Dim SonuçDizisi() As Variant
Dim r As Long, c As Long
Dim vbaKodu As String
Dim modül As Object
Dim fonksiyonAdı As String

ReDim SonuçDizisi(1 To satırlar, 1 To sütunlar)

' Geçici bir VBA fonksiyonu oluştur (dikkatli kullanın)
fonksiyonAdı = "GeçiciLambda_" & Replace(Replace(Now(), ":", ""), " ", "_")
vbaKodu = "Function " & fonksiyonAdı & "(satır As Long, sütun As Long) As Variant\n" & _
" " & lambda_fonksiyon & "\n" & _
"End Function"

Set modül = ThisWorkbook.VBProject.VBComponents.Add(1) ' 1 = vbext_ct_StdModule
modül.CodeModule.AddFromString vbaKodu

On Error Resume Next
For r = 1 To satırlar
For c = 1 To sütunlar
SonuçDizisi(r, c) = Application.Run(fonksiyonAdı, r, c)
Next c
Next r
On Error GoTo 0

' Geçici modülü sil
ThisWorkbook.VBProject.VBComponents.Remove modül

UDF_DİZİOLUŞTUR = SonuçDizisi
End Function

' FİLTRE Fonksiyonu Benzeri
Function UDF_FİLTRE(dizi As Range, koşul As Variant, [yoksa_boş]) As Variant
Dim SonuçDizisi() As Variant
Dim i As Long, j As Long
Dim Sayac As Long
Dim KoşulDizisi As Variant
Dim SatırSayısı As Long
Dim SütunSayısı As Long

If TypeOf koşul Is Range Then
KoşulDizisi = koşul.Value
Else
ReDim KoşulDizisi(1 To dizi.Rows.Count, 1 To 1)
For i = 1 To dizi.Rows.Count
KoşulDizisi(i, 1) = koşul
Next i
End If

SatırSayısı = dizi.Rows.Count
SütunSayısı = dizi.Columns.Count
ReDim SonuçDizisi(1 To SatırSayısı, 1 To SütunSayısı)
Sayac = 0

For i = 1 To SatırSayısı
If KoşulDizisi(i, 1) Then
Sayac = Sayac + 1
For j = 1 To SütunSayısı
ReDim Preserve SonuçDizisi(1 To Sayac, 1 To SütunSayısı)
SonuçDizisi(Sayac, j) = dizi.Cells(i, j).Value
Next j
End If
Next i

If Sayac = 0 Then
If IsMissing(yoksa_boş) Then
UDF_FİLTRE = CVErr(xlErrNA)
Else
UDF_FİLTRE = yoksa_boş
End If
Else
UDF_FİLTRE = SonuçDizisi
End If
End Function

' İLKEŞLEŞEN Fonksiyonu Benzeri (Basit Yaklaşım - Tam işlevsellik için daha karmaşık bir UDF gerekebilir)
Function UDF_İLKEŞLEŞEN(arama_değeri As Variant, arama_dizisi As Range, [eşleşme_türü]) As Variant
UDF_İLKEŞLEŞEN = Application.Match(arama_değeri, arama_dizisi, IIf(IsMissing(eşleşme_türü), 0, eşleşme_türü))
End Function

' METİNBİRLEŞTİR Fonksiyonu Benzeri
Function UDF_METİNBİRLEŞTİR(ayraç As String, yokSayBoş As Boolean, ParamArray metinler() As Variant) As String
Dim Sonuc As String
Dim Metin As Variant

Sonuc = ""
For Each Metin In metinler
If Not yokSayBoş Or Metin <> "" Then
If Sonuc <> "" Then Sonuc = Sonuc & ayraç
Sonuc = Sonuc & Metin
End If
Next Metin
UDF_METİNBİRLEŞTİR = Sonuc
End Function

' METİNBÖL Fonksiyonu Benzeri
Function UDF_METİNBÖL(metin As String, sütun_ayracı As String, [satır_ayracı], [yoksay_boş], [eşleşme_büyük_küçük], [dolgu_değeri]) As Variant
Dim Sütunlar() As String
Dim Satırlar() As String
Dim SonuçDizisi() As Variant
Dim i As Long, j As Long
Dim maxSütun As Long
Dim satırAyraçVar As Boolean

satırAyraçVar = Not IsMissing(satır_ayracı)

If satırAyraçVar Then
Satırlar = Split(metin, satır_ayracı)
ReDim SonuçDizisi(LBound(Satırlar) To UBound(Satırlar), 0 To 0) ' Geçici boyutlandırma
For i = LBound(Satırlar) To UBound(Satırlar)
Sütunlar = Split(Satırlar(i), sütun_ayracı)
maxSütun = WorksheetFunction.Max(maxSütun, UBound(Sütunlar) + 1)
ReDim Preserve SonuçDizisi(LBound(Satırlar) To UBound(Satırlar), 1 To maxSütun)
For j = LBound(Sütunlar) To UBound(Sütunlar)
If Not yoksay_boş Or Sütunlar(j) <> "" Then
SonuçDizisi(i + 1, j + 1) = Sütunlar(j)
Else
SonuçDizisi(i + 1, j + 1) = IIf(IsMissing(dolgu_değeri), "", dolgu_değeri)
End If
Next j
' Eksik sütunları dolgu değeriyle doldur
If UBound(Sütunlar) + 1 < maxSütun Then
For j = UBound(Sütunlar) + 2 To maxSütun
SonuçDizisi(

Genişletmek için tıkla...

kralım' Alıntı:

Umarım doğru olmuştur.

Genişletmek için tıkla...

pitchoute' Alıntı:

Alternatif ve örnek olması açışından ekliyorum, iyi çalışmalar.
HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

HTML:

Kod: Panoya Kopyala

İçeriği görebilmek için Giriş yap ya da Üye ol.

Genişletmek için tıkla...