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ş: 50
İleti: 138
 
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ş: 50
İleti: 138
 
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
Siteye Alışmış
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 38
İleti: 417
 
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
Siteye Alışmış
 
Kayıt: 26 Arl 2016 19:07
Meslek: Harita/Ölçme
Yaş: 38
İleti: 417
 
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ş: 50
İleti: 138
 
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ş: 50
İleti: 138
 
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ş: 50
İleti: 138
 
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ş: 50
İleti: 138
 
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ş: 50
İleti: 138
 
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