Elzem KTF(UDF)ler

Excel sayfalarında kullandığımız yerleşik fonksiyonlar ya da kendi yazabileceğiniz fonksiyonlar ile ilgili bilmek istedikleriniz, sorunlar ve çözümleri

Elzem KTF(UDF)ler

İleti#1)  Tamermaster » 15 Şub 2020 02:43

Bir hücre başvurusunda birden fazla kelimeyi değiştiren KTF
Kod: Tümünü seç
Function Yenile(Metin As Variant, ByVal Eski As Variant, ByVal Yeni As Variant, _
Optional ByVal Eski1 As Variant = "", Optional ByVal Yeni1 As Variant = "", _
Optional ByVal Eski2 As Variant = "", Optional ByVal Yeni2 As Variant = "", _
Optional ByVal Eski3 As Variant = "", Optional ByVal Yeni3 As Variant = "", _
Optional ByVal Eski4 As Variant = "", Optional ByVal Yeni4 As Variant = "")

Kod1 = Replace(Metin, Eski, Yeni)
Kod2 = Replace(Kod1, Eski1, Yeni1)
Kod3 = Replace(Kod2, Eski2, Yeni2)
Kod4 = Replace(Kod3, Eski3, Yeni3)
Kod5 = Replace(Kod4, Eski4, Yeni4)
Yenile = Kod5

End Function

KDV li fiyattan KDV siz fiyatı bulan KTF
Kod: Tümünü seç
Function FiyatBul(Tutar As Double, Optional ByVal Yüzde As Currency)

If Yüzde = Empty Then
FiyatBul = Tutar / 1.18
Else
    If Yüzde < 1 Then
    Oran = Yüzde
    Else
    Oran = (Yüzde / 100)
    End If
    FiyatBul = Tutar / (1 + Oran)
End If
End Function

KDV li fiyattan KDV yi bulan KTF
Kod: Tümünü seç
Function KDV(Fiyat As Double, Optional ByVal Yüzde As Currency)

If Yüzde = Empty Then
KDV = Fiyat * 1.18
Else
    If Yüzde < 1 Then
    Oran = Yüzde
    Else
    Oran = (Yüzde / 100)
    End If
    KDV = Fiyat * (1 + Oran)
End If

End Function

Direnç Watt Ohm değeri bulan KTF
Kod: Tümünü seç
Function Direnç(Volt, Akım As Double)
Wat = Left((Volt * Akım), 6)
Dren = Left((Volt / Akım), 6)
If Dren < 1000 Then
Direnç = Dren & " Ohm " & Wat & " W"
Else
Direnç = Dren / 1000 & " K " & Wat & " W"
End If
End Function
Kullanıcı avatarı
Tamermaster
Siteye Alışmış
 
Adı Soyadı:Tamer Muhassıl
Kayıt: 25 May 2009 01:04
Konum: İstanbul/Bahçelievler
Meslek: Elektronik
Yaş: 51
İleti: 147
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Bahçelievler

Cevap: Elzem KTF(UDF)ler

İleti#2)  Tamermaster » 15 Şub 2020 02:54

Aranan değerin satır numarasını bulan KTF
Aranan değer birden fazla ise kaçıncı değerin satır numarasını istiyorsanız bulan KTF
Kod: Tümünü seç
Function AraStrNoYaz(ByVal Aranan As String, ByVal AramaAlani As Range, ByVal KacSutun As Integer, Optional ByVal Kacinci As Integer) As String
On Error Resume Next
Dim Metin As String, Veri As Variant, i As Long

If Aranan = "" Then Exit Function
Veri = AramaAlani.Value2
For i = 1 To UBound(Veri)
    If CStr(Veri(i, KacSutun)) = Aranan Then
     Metin = Metin & i & ";"
    End If
Next i
If Kacinci = "" Then Kacinci = 1
Dizi = Split(Metin, ";")
    AraStrNoYaz = Dizi(Kacinci - 1)
End Function
Kullanıcı avatarı
Tamermaster
Siteye Alışmış
 
Adı Soyadı:Tamer Muhassıl
Kayıt: 25 May 2009 01:04
Konum: İstanbul/Bahçelievler
Meslek: Elektronik
Yaş: 51
İleti: 147
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Bahçelievler

Cevap: Elzem KTF(UDF)ler

İleti#3)  Miraç CAN » 15 Şub 2020 08:30

Burada bir sıkıntı var. Fonksiyon tanımı mı yanlış yoksa?
KDV'li fiyat bulma olabilir ancak.
Tamermaster yazdı:KDV li fiyattan KDV yi bulan KTF
Kod: Tümünü seç
Function KDV(Fiyat As Double, Optional ByVal Yüzde As Currency)

If Yüzde = Empty Then
KDV = Fiyat * 1.18
Else
    If Yüzde < 1 Then
    Oran = Yüzde
    Else
    Oran = (Yüzde / 100)
    End If
    KDV = Fiyat * (1 + Oran)
End If

End Function

KDV li fiyattan KDV yi bulan KTF;
Kod: Tümünü seç
Function KDV(Fiyat As Double, Optional ByVal Yüzde As Currency)
If Yüzde = Empty Then
KDV = Fiyat - (Fiyat / 1.18)
Else
    If Yüzde < 1 Then
    Oran = Yüzde
    Else
    Oran = (Yüzde / 100)
    End If
    KDV = Fiyat - (Fiyat / (1 + Oran))
End If

End Function
Kullanıcı avatarı
Miraç CAN
Site Dostu
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 39
İleti: 699
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya & Adana

Cevap: Cevap: Elzem KTF(UDF)ler

İleti#4)  Miraç CAN » 15 Şub 2020 08:32

Tamermaster yazdı:Aranan değerin satır numarasını bulan KTF
Aranan değer birden fazla ise kaçıncı değerin satır numarasını istiyorsanız bulan KTF
Kod: Tümünü seç
Function AraStrNoYaz(ByVal Aranan As String, ByVal AramaAlani As Range, ByVal KacSutun As Integer, Optional ByVal Kacinci As Integer) As String
On Error Resume Next
Dim Metin As String, Veri As Variant, i As Long

If Aranan = "" Then Exit Function
Veri = AramaAlani.Value2
For i = 1 To UBound(Veri)
    If CStr(Veri(i, KacSutun)) = Aranan Then
     Metin = Metin & i & ";"
    End If
Next i
If Kacinci = "" Then Kacinci = 1
Dizi = Split(Metin, ";")
    AraStrNoYaz = Dizi(Kacinci - 1)
End Function

Gayet kullanışlı KTF'ler olmuş Tamer Bey, ellerinize sağlık, teşekkürler paylaşımınız için.
Kullanıcı avatarı
Miraç CAN
Site Dostu
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 39
İleti: 699
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya & Adana

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Elzem KTF(UDF)ler

İleti#5)  Tamermaster » 15 Şub 2020 15:39

Haklısın KDV'li fiyatı bulan KTF olacak teşekkür ederim
Eksiğimizi tamamlayalım o zaman.
Fiyattan KDV bulan KTF
Kod: Tümünü seç
Function KDVBul(Fiyat As Double, Optional ByVal Yüzde As Currency)
skz = Int(Fiyat - (Fiyat / 1.08))
oskz = Int(Fiyat - (Fiyat / 1.18))

If Yüzde = Empty Then
    If Fiyat = (skz + (Fiyat / 1.08)) Then
    KDVBul = Fiyat - (Fiyat / 1.08)
    Else
    KDVBul = Fiyat - (Fiyat / 1.18)
    End If
Else
    If Yüzde < 1 Then
    KDVBul = Fiyat - (Fiyat / (1 + Yüzde))
    Else
    KDVBul = Fiyat - (Fiyat / ((100 + Yüzde) / 100))
    End If
End If

End Function
Kullanıcı avatarı
Tamermaster
Siteye Alışmış
 
Adı Soyadı:Tamer Muhassıl
Kayıt: 25 May 2009 01:04
Konum: İstanbul/Bahçelievler
Meslek: Elektronik
Yaş: 51
İleti: 147
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Bahçelievler

Cevap: Elzem KTF(UDF)ler

İleti#6)  Tamermaster » 25 Şub 2020 14:25

FazlaYenile
Yerinekoy Fonksiyonu bildiğiniz gibi kaç tane varsa tamamını yeniler. Bu Fonksiyon bulunan değer Birden fazla İse ve hepsini değiştirmek istemiyorsanız, sadece değiştirmek istediğinizi değiştirecektir.
Örnek aynı cümle(Hücre) içinde 4 tane aynı kelime var siz sadece 3.yü değiştirmek istiyorsanız KacYenile ile bunu yapabiliyorsunuz.
Güle güle kullanın.
Not : bir kelime(bölüm) içinde harf değiştirmek isterseniz o kelimede de o harften birden fazla var ise o kelime içindeki o harfleri değiştirir.
Kod: Tümünü seç
Function KacYenile(ByVal Hücre As String, Bul As String, Değiştir As String, Optional Kaçıncı As Byte)
Dim a As Byte, b As Byte, say As Byte, i As Byte, s As Byte
Dim Bak As String, Bak1 As String, Bak2 As String, Bak3 As String, Bak4 As String, Bak5 As String, Bak6 As String
a = 0
b = 0
Dim Klm
Klm = Split(Hücre, " ")
For say = LBound(Klm) To UBound(Klm)
Veri = Klm(say)
b = b + 1
If InStr(Veri, Bul) > 0 Then
a = a + 1
If a = Kaçıncı Then
  For i = LBound(Klm) To b - 1
   Bak = Bak & " " & Klm(i)
  t = b
  Next i
End If
End If
Next say
Bak2 = Replace(Klm(t - 1), Bul, Değiştir)
Bak3 = Bak & " " & Bak2
For s = t To UBound(Klm)
Bak4 = Bak4 & " " & Klm(s)
Next s
Bak5 = Bak3 & Bak4
Bak6 = Right(Bak5, Len(Bak5) - 1)
KacYenile = Bak6
End Function

Lütfen KTF leri denedikten sonra eksik gördüklerinizi paylaşın.
Kullanıcı avatarı
Tamermaster
Siteye Alışmış
 
Adı Soyadı:Tamer Muhassıl
Kayıt: 25 May 2009 01:04
Konum: İstanbul/Bahçelievler
Meslek: Elektronik
Yaş: 51
İleti: 147
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Bahçelievler

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Elzem KTF(UDF)ler

İleti#7)  Tamermaster » 05 Mar 2020 19:46

Dirençler üzerinden geçen akım ve voltajı veren KTF
Kod: Tümünü seç
Function DirenceDüşen(BeslemeVoltajı As Double, Direnç1 As Double, Optional Direnç2 As Double, Optional Direnç3 As Double, Optional Direnç4 As Double, Optional Direnç5 As Double, _
Optional Direnç6 As Double, Optional Direnç7 As Double, Optional Direnç8 As Double, Optional Direnç9 As Double, Optional Direnç10 As Double, Optional Direnç11 As Double, _
Optional Direnç12 As Double, Optional Direnç13 As Double, Optional Direnç14 As Double, Optional Direnç15 As Double, Optional Direnç16 As Double, Optional Direnç17 As Double)
Değişken = Array(Direnç1, Direnç2, Direnç3, Direnç4, Direnç5, Direnç6, Direnç7, Direnç8, Direnç9, Direnç10, Direnç11, Direnç12, Direnç13, Direnç14, Direnç15, Direnç16, Direnç17)
Dim i As Byte, TDirenç As Double, Dolu As Byte, Ampe As Double

For i = LBound(Değişken) To UBound(Değişken)
If Değişken(i) <> 0 Then
TDirenç = Değişken(i) + TDirenç
Dolu = i
End If
Next i
amp = BeslemeVoltajı / TDirenç
For v = LBound(Değişken) To UBound(Değişken)
If Değişken(v) <> 0 Then
Rv = Rv & "Rv" & v + 1 & "= " & (Değişken(v) * amp) & "Volt, "
End If
Next v
rvs = Left(Rv, Len(Rv) - 2)
DirenceDüşen = amp & " Amper ," & rvs
End Function
Kullanıcı avatarı
Tamermaster
Siteye Alışmış
 
Adı Soyadı:Tamer Muhassıl
Kayıt: 25 May 2009 01:04
Konum: İstanbul/Bahçelievler
Meslek: Elektronik
Yaş: 51
İleti: 147
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Bahçelievler

Cevap: Elzem KTF(UDF)ler

İleti#8)  Tamermaster » 09 Mar 2020 14:05

Yazarken kontrol eden Eğer fonksiyonu KTF.


Kod: Tümünü seç
Function eeyer(x As Variant, y As Byte, A As Variant, Optional ByVal Ae, Optional ByVal Ab, Optional ByVal Ak, Optional ByVal Aeb, Optional ByVal Aek As Variant)

If y = 1 Then
If x < A Then
  If Ab <> "" Then
  eeyer = Ab
  Else
  eeyer = "A X ten Büyük"
  End If
ElseIf x > A Then
  If Ak <> "" Then
   eeyer = Ak
  Else
  eeyer = "A X ten Küçük"
  End If
Else
  If Ae <> "" Then
  eeyer = Ae
  Else
  eeyer = "A X e Eşit"
  End If
End If
ElseIf y = 2 Then
If x >= A Then
  If Aek <> "" Then
  eeyer = Aek
  Else
  eeyer = "A X e Eşit Yada A X ten Küçük"
  End If
Else
  If Aeb <> "" Then
  eeyer = Aeb
  Else
  eeyer = " A X e Eşit Yada A X ten Büyük"
  End If
End If

End If

End Function
Kullanıcı avatarı
Tamermaster
Siteye Alışmış
 
Adı Soyadı:Tamer Muhassıl
Kayıt: 25 May 2009 01:04
Konum: İstanbul/Bahçelievler
Meslek: Elektronik
Yaş: 51
İleti: 147
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Bahçelievler

Cevap: Cevap: Elzem KTF(UDF)ler

İleti#9)  Tamermaster » 09 Mar 2020 15:30

X ve A değerleri kontrol edilecek değerler.
Y Kontrol sonucu her iki ihtimali içeriyorsa 2, tek karşılaştırma sonucu için 1 yazılmalı
Ae ye X A ya eşitse girilecek değer.
Ab ye A X ten büyükse girilecek değer.
Ak ye A X ten küçükse girilecek değer.
Aeb ye A X ten büyük yada X e eşitse gelecek değer.
Aek ye A X ten küçük yada X e eşitse gelecek değer girilir.
Aeb ve Aek de sonuç istiyorsanız Y ye 2 yazın, tek sonuç için Y ye 1 yazın.
Sonuç bölümleri (Ae,Ab,Ak,Aeb,Akb) boş bırakılırsa değerlendirme sonucunu yazar.
(Önceki KTF sonuç değerleri yerine değişken ile yazar.)
Tamermaster yazdı:Yazarken kontrol eden Eğer fonksiyonu KTF.


Kod: Tümünü seç
Function eeyer(X As Variant, Y As Byte, A As Variant, Optional ByVal Ae, Optional ByVal Ab, Optional ByVal Ak, Optional ByVal Aeb, Optional ByVal Aek As Variant)

If Y = 1 Then
If X < A Then
  If Ab <> "" Then
  eeyer = Ab
  Else
  eeyer = A & " " & X & " ten Büyük"
  End If
ElseIf X > A Then
  If Ak <> "" Then
   eeyer = Ak
  Else
  eeyer = A & " " & X & " ten Küçük"
  End If
Else
  If Ae <> "" Then
  eeyer = Ae
  Else
  eeyer = A & " " & X & "e Eşit"
  End If
End If
ElseIf Y = 2 Then
If X >= A Then
  If Aek <> "" Then
  eeyer = Aek
  Else
  eeyer = A & " " & X & " e Eşit Yada " & A & " " & X & " ten Küçük"
  End If
Else
  If Aeb <> "" Then
  eeyer = Aeb
  Else
  eeyer = A & " " & X & " e Eşit Yada " & A & " " & X & " ten Büyük"
  End If
End If

End If

End Function
Kullanıcı avatarı
Tamermaster
Siteye Alışmış
 
Adı Soyadı:Tamer Muhassıl
Kayıt: 25 May 2009 01:04
Konum: İstanbul/Bahçelievler
Meslek: Elektronik
Yaş: 51
İleti: 147
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Bahçelievler

Cevap: Elzem KTF(UDF)ler

İleti#10)  Tamermaster » 13 Ağu 2020 10:46

Üçgen ile ilgili KTF'ler
Eşkenar üçgende alan bulma fonksiyonu
Kod: Tümünü seç
Function EşKenarAlan(Kenar_Uzunluğu As Double)
kök = (3 ^ (1 / 2)) / 4
EşKenarAlan = Kenar_Uzunluğu ^ 2 * kök
End Function
Kullanıcı avatarı
Tamermaster
Siteye Alışmış
 
Adı Soyadı:Tamer Muhassıl
Kayıt: 25 May 2009 01:04
Konum: İstanbul/Bahçelievler
Meslek: Elektronik
Yaş: 51
İleti: 147
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Bahçelievler

Cevap: Elzem KTF(UDF)ler

İleti#11)  Tamermaster » 13 Ağu 2020 10:48

Dik üçgende Hipotenüs uzunluğu bulma fonksiyonu

Kod: Tümünü seç
Function Hipotenüs(Kenar1, Kenar2 As Double)
Hipotenüs = (Kenar1 ^ 2 + Kenar2 ^ 2) ^ (1 / 2)

End Function
Kullanıcı avatarı
Tamermaster
Siteye Alışmış
 
Adı Soyadı:Tamer Muhassıl
Kayıt: 25 May 2009 01:04
Konum: İstanbul/Bahçelievler
Meslek: Elektronik
Yaş: 51
İleti: 147
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Bahçelievler

Cevap: Elzem KTF(UDF)ler

İleti#12)  Tamermaster » 13 Ağu 2020 10:49

Uzunkenarı(Hipotenüsü) bilinen dik üçgende kenar uzunluğu bulma fonksiyonu

Function DikÜçgenKenar(Hipotenüs, Kenar As Double)
DikÜçgenKenar = (Hipotenüs ^ 2 - Kenar ^ 2) ^ (1 / 2)
End Function
Kullanıcı avatarı
Tamermaster
Siteye Alışmış
 
Adı Soyadı:Tamer Muhassıl
Kayıt: 25 May 2009 01:04
Konum: İstanbul/Bahçelievler
Meslek: Elektronik
Yaş: 51
İleti: 147
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Bahçelievler

Cevap: Elzem KTF(UDF)ler

İleti#13)  Tamermaster » 13 Ağu 2020 10:51

Kenar uzunlukları bilinen üçgende alan bulma fonksiyonu

Kod: Tümünü seç
Function ÜçgenAlan(a, b, c As Double)
s = (a + b + c) / 2
ÜçgenAlan = (s * (s - a) * (s - b) * (s - c)) ^ (1 / 2)
End Function
Kullanıcı avatarı
Tamermaster
Siteye Alışmış
 
Adı Soyadı:Tamer Muhassıl
Kayıt: 25 May 2009 01:04
Konum: İstanbul/Bahçelievler
Meslek: Elektronik
Yaş: 51
İleti: 147
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Bahçelievler

Cevap: Elzem KTF(UDF)ler

İleti#14)  Tamermaster » 16 Eyl 2020 00:10

Ardışık sayıların toplanması için fonksiyon.
Kod: Tümünü seç
Function ArdışıkTopla(Sayı As Integer, Optional ByVal Başlangıç As Integer)

If Başlangıç > 0 Then
    If Sayı Mod 2 = 0 Then
    Birden = (Sayı + 1) * (Sayı / 2)
    BirdenBaş = (Başlangıç + 1) * (Başlangıç / 2)
    ArdışıkTopla = Birden - BirdenBaş + Başlangıç
    Else
    Birden = ((Sayı + 1) / 2) * Sayı
    BirdenBaş = ((Başlangıç + 1) / 2) * Başlangıç
    ArdışıkTopla = Birden - BirdenBaş + Başlangıç
    End If
Else
    If Sayı Mod 2 = 0 Then
    ArdışıkTopla = (Sayı + 1) * (Sayı / 2)
    Else
    ArdışıkTopla = ((Sayı + 1) / 2) * Sayı
    End If
End If
Kullanıcı avatarı
Tamermaster
Siteye Alışmış
 
Adı Soyadı:Tamer Muhassıl
Kayıt: 25 May 2009 01:04
Konum: İstanbul/Bahçelievler
Meslek: Elektronik
Yaş: 51
İleti: 147
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Bahçelievler

Cevap: Cevap: Elzem KTF(UDF)ler

İleti#15)  Arkadasca » 16 Eyl 2020 09:31

Tamermaster yazdı:Dik üçgende Hipotenüs uzunluğu bulma fonksiyonu

Kod: Tümünü seç
Function Hipotenüs(Kenar1, Kenar2 As Double)
Hipotenüs = (Kenar1 ^ 2 + Kenar2 ^ 2) ^ (1 / 2)

End Function


Paylaşımlarınız için teşekkür ederim. Emeğinize sağlık...

Yukarıdaki fonksiyonun kullanımı ile ilgili bir örnek paylaşabilir misiniz?
Kullanıcı avatarı
Arkadasca
Siteye Alışmış
 
Kayıt: 22 Kas 2016 15:59
Meslek: kalite sorumlusu
Yaş: 48
İleti: 350
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İSTANBUL

Cevap: Elzem KTF(UDF)ler

İleti#16)  Miraç CAN » 16 Eyl 2020 09:53

Fonksiyonu bir modüle ekleyip herhangi bir makroya UzunKenar = Hipotenüs(3, 4)
Ya da hücreye =Hipotenüs(3;4)
Kullanıcı avatarı
Miraç CAN
Site Dostu
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 39
İleti: 699
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya & Adana

Cevap: Cevap: Elzem KTF(UDF)ler

İleti#17)  Arkadasca » 16 Eyl 2020 10:07

Miraç CAN yazdı:Fonksiyonu bir modüle ekleyip herhangi bir makroya UzunKenar = Hipotenüs(3, 4)
Ya da hücreye =Hipotenüs(3;4)


Miraç Bey,
İlginiz için teşekkür ederim.
VBA tarafındaki uygulamayı biliyorum.
Örnek kullanımı sormuştum. Bir üçgenin kenarlarını nasıl hesaplıyor?
Formül üzerinden mi gidiliyor?
Örnek gönderir misiniz?
Kullanıcı avatarı
Arkadasca
Siteye Alışmış
 
Kayıt: 22 Kas 2016 15:59
Meslek: kalite sorumlusu
Yaş: 48
İleti: 350
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İSTANBUL

Cevap: Elzem KTF(UDF)ler

İleti#18)  Miraç CAN » 16 Eyl 2020 10:42

Adsız.png
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
Miraç CAN
Site Dostu
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 39
İleti: 699
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Amasya & Adana

Cevap: Elzem KTF(UDF)ler

İleti#19)  Tamermaster » 23 Eyl 2020 12:06

Biran fazla sonuç veren aramalarda kullanabileceğiniz bir düşey arama KTF si

Kod: Tümünü seç
Function AraAyir(ByVal aranan As String, ByVal AramaAlani As Range, ByVal Kacinci_Sutun As Integer, Optional ByVal Kacinci_Kelime As Integer = 1) As String
Dim Metin As String, Veri As Variant, i As Long
If aranan = "" Then Exit Function
Veri = AramaAlani.Value2
For i = 1 To UBound(Veri)
    If CStr(Veri(i, 1)) = aranan Then
   
        Metin = Metin & Veri(i, Kacinci_Sutun) & "/"
    End If
Next i
    Sonuc = Mid(Metin, 1, Len(Metin) - 1)
   
        If InStr(1, Sonuc, "/", vbTextCompare) > 0 Then
        Dim Dizi
        Dim say As Integer
        Dizi = Split(Sonuc, "/")
        say = UBound(Dizi) + 1
        If Kacinci_Kelime > say Then AraAyir = 0
        If Kacinci_Kelime < 1 Then Kacinci_Kelime = 1
        AraAyir = Dizi(Kacinci_Kelime - 1)
    Else
        AraAyir = ""
  End If
End Function
Kullanıcı avatarı
Tamermaster
Siteye Alışmış
 
Adı Soyadı:Tamer Muhassıl
Kayıt: 25 May 2009 01:04
Konum: İstanbul/Bahçelievler
Meslek: Elektronik
Yaş: 51
İleti: 147
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Bahçelievler

Cevap: Elzem KTF(UDF)ler

İleti#20)  Tamermaster » 26 Eyl 2020 00:45

Seçim değişkenine yazacağınız değere göre farklı kullanabilirsiniz. Son dolu hücreyi sütunu 1. satırdan seçersek verir.
Son dolu hücreyi bulur(1)
Boş hücrelerin sayısını verir( Boş bıraksanız da 0 yasanızda fark etmez )
Dolu hücrelerin sayısını verir(2)
Rakam bulunan hücrelerin sayısını verir(3)
Metin bulunan hücrelerin sayısını verir(4)
Kod: Tümünü seç
Function SonBul(ByVal AramaSutunu As Range, Optional ByVal Seçim As Double) As String
On Error Resume Next
Dim Veri As Variant
Dim i As Long
Dim b As Long
Dim s As Long
Dim m As Long
Dim bos As Long
Dim soon As Long

Veri = AramaSutunu.Value2
For i = 1 To UBound(Veri)
If Veri(i, 1) <> "" Then
If Veri(i, 1) <> "" Then
b = b + 1
If IsNumeric(Veri(i, 1)) Then
s = s + 1
End If
If Not IsNumeric(Veri(i, 1)) Then
m = m + 1
End If
End If
soon = i
Else
bos = bos + 1
End If
Next i
If Seçim <> "" Then
If Seçim = 1 Then
Sonuç = soon
ElseIf Seçim = 2 Then
Sonuç = b
ElseIf Seçim = 3 Then
Sonuç = s
ElseIf Seçim = 4 Then
Sonuç = m
ElseIf Seçim = 0 Then
Sonuç = bos
End If
End If

    SonBul = Sonuç
End Function

[url][url=https://hizliresim.com/E7QbLG]Resim[/url][/url]
Kullanıcı avatarı
Tamermaster
Siteye Alışmış
 
Adı Soyadı:Tamer Muhassıl
Kayıt: 25 May 2009 01:04
Konum: İstanbul/Bahçelievler
Meslek: Elektronik
Yaş: 51
İleti: 147
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: İstanbul/Bahçelievler


Forum Kullanıcı Tanımlı Fonksiyonlar ( KTF )

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 1 misafir

Bumerang - Yazarkafe