• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Formülün WorksheetFunction şeklinde yazılması

  • Konbuyu başlatan Konbuyu başlatan s.savas
  • Başlangıç tarihi Başlangıç tarihi
S

s.savas

Katılım
12 Ocak 2009
Mesajlar
838
Excel Vers. ve Dili
2003
İyi akşamlar arkadaşlar.
Aşağıdaki formülü WorksheetFunction şeklinde makro olarak yazabilirmiyiz.
AL4:AL500 aralığı için;
Kod: 
{=EĞER(SÜTUNSAY($AL$4:AL4)<=$AK4;İNDİS($E$3:$AH$3;KÜÇÜK(EĞER($E4:$AH4=$AJ4;SÜTUN($E4:$AH4)-SÜTUN($E4)+1);SÜTUNSAY($AL$4:AL4)));"Teklif Yok")}
 
Selam,

formülünüzden anlaşılan, siz formül olan hücreyi sürüklüyor olmanız gerek. Örnek bir dosya eklerseniz sorunuz daha anlaşılır olacak ve alternatif çözümlere ulaşacaktır.
İyi çalışmalar
 
Üstat ilginize teşekkür ederim.
Örnek olarak ekte sunulan belgenin Mukayese Cetveli isimli sayfanın AL4:AL150 aralındaki 1.En Düşük Firmayı bulan formülün makro olarak işlev görmesini istiyorum.Yukarıda yazılan formülün makroya çevrilmesini görüp ona göre diğer formülleri de kendim yapmak istedim.
Çünkü çalıştığım orjinal çalışma sayfasında sekme sayısı arttıkça dolayısıyla bu formüle benzer de artıyor ve dosya inanılmaz bir şekilde büyüyor.
Dosya boyutunun minimuma indirilmesi için belgede kullandığım formülleri makroya terfi etmek istiyorum.
 

Ekli dosyalar

Selam,
Bir çalışma yapıp en kısa zamanda göndereceğim.
İyi çalışmalar.
 
Selamlar,

Dosyanız üzerinde gerekli düzenlemeyi yaptım. İncelermisiniz. Problemli yerler varsa belirtin düzeltelim.
 

Ekli dosyalar

s.savas' Alıntı:
Sabırsızlıkla bekliyorum.
Formüller bir butona tanımlanarakta yapılabilir, diye düşünüyorum.:mutlu:
Genişletmek için tıkla ...

Selam,
Dosyanız 13.mesajdadır inceler misiniz?
"Menü" sayfasındaki seçiminize göre sayfa bilgileri "Mukayese Cetveli" adlı sayfaya aktarılacaktır.
Daha sonra "Mukayese Cetveli" sayfasına fiyat bilgilerini girdikten sonra "GÜNCELLE" butonuna basınız. Fonksiyonlar ile yaptığınız tüm işlemleri kodlar yapacaktır.

İyi çalışmalar.
 
Son düzenleme:
Selamlar,

İstediğiniz düzeltme işlemini üstteki mesajımdaki dosyada yaptım. İncelermisiniz.

s.savas' Alıntı:
Korhan hocam harikasınız.
Fiyatların girildiği E:H sütun sınırlamasını E:AH olarak genişletilmesini isterim.
Genişletmek için tıkla ...
 
Ergün Güler' Alıntı:
Selam,
Dosyanız ektedir inceler misiniz?
"Menü" sayfasındaki seçiminize göre sayfa bilgileri "Mukayese Cetveli" adlı sayfaya aktarılacaktır.
Daha sonra "Mukayese Cetveli" sayfasına fiyat bilgilerini girdikten sonra "GÜNCELLE" butonuna basınız. Fonksiyonlar ile yaptığınız tüm işlemleri kodlar yapacaktır.

İyi çalışmalar.
Genişletmek için tıkla ...

Ergün hocam ellerinize sağlık çok güzel olmuş, ancak E3:AH3 aralığına girdiğiniz fiyatları silip tekrar farklı fiyatlar girildiği zaman 2.en ucuz fiyatları teklif eden firmaları hesaplayamıyor.2. en düşük fiyatı teklif eden firmalar arasından 1.en düşük firma için teklif olmasına rağmen teklif yok diyor. Aralıktaki en yüksek fiyatı hesaplıyor.
 
Korhan Ayhan' Alıntı:
Selamlar,

İstediğiniz düzeltme işlemini üstteki mesajımdaki dosyada yaptım. İncelermisiniz.
Genişletmek için tıkla ...

Korhan hocam sizinde elleriniz dert görmesin, harika oldu.
Küçük bir hata vardı, onuda deneme yanılma ile çözdüm sanırım.
Aşağıdaki kodlarda düzenleme yaptım.
If Intersect(Target, Range("E4:AH65536")) Is Nothing Then Exit Sub
If Hücre.Column >= 5 And Hücre.Column <= 34 Then
If WF.CountA(Range("E" & Hücre.Row & ":AH" & Hücre.Row)) > 0 Then
For X = 5 To 34
 
Selamlar,

Haklısınız. O bölümleri düzeltmeyi unutmuşum. Üstteki mesajımdaki dosyayı tekrar güncelledim.
 
s.savas' Alıntı:
Ergün hocam ellerinize sağlık çok güzel olmuş, ancak E3:AH3 aralığına girdiğiniz fiyatları silip tekrar farklı fiyatlar girildiği zaman 2.en ucuz fiyatları teklif eden firmaları hesaplayamıyor.2. en düşük fiyatı teklif eden firmalar arasından 1.en düşük firma için teklif olmasına rağmen teklif yok diyor. Aralıktaki en yüksek fiyatı hesaplıyor.
Genişletmek için tıkla ...

Selam,
Haklısınız. Module3'teki kırmızı alandaki değişikliği uygulayınız.

kodlar aşağıdaki gibi olacaktır.

Menü kod sayfasına
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim menu As Worksheet
Dim sayfa As Worksheet
Dim mc As Worksheet

Set menu = Sheets("Menü")
Set mc = Sheets("Mukayese Cetveli")

If Intersect(Target, menu.Range("G12")) Is Nothing Then Exit Sub
    If Target = "Mal Alımı" Then
    Set sayfa = Sheets("Malzeme_Listesi")
    End If

    If Target = "İlaç Alımı" Then
    Set sayfa = Sheets("İlaç_Listesi")
    End If

son = sayfa.Cells(65536, "A").End(3).Row

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
mc.Range("A4:D65536").ClearContents

For i = 3 To son

mc.Cells(i + 1, "A") = sayfa.Cells(i, "A")
mc.Cells(i + 1, "B") = sayfa.Cells(i, "B")
mc.Cells(i + 1, "C") = sayfa.Cells(i, "C")
mc.Cells(i + 1, "D") = sayfa.Cells(i, "E")

Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox sayfa.Name & " Sayfasındaki Malzeme Bilgileri " & vbLf & mc.Name & " Sayfaya Aktarılmıştır.", vbInformation

End Sub

module3'e:

Kod: 
Sub en_dusuk_teklifleri_bul()
Dim mc As Worksheet
Dim son As Long
Dim fiyat As Range

Set mc = Sheets("Mukayese cetveli")
son = mc.Cells(65536, "A").End(3).Row

mc.Range("AJ4:AV65536").ClearContents
mc.Range("AL3:AO3").ClearContents
mc.Range("AR3:AU3").ClearContents

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


For i = 4 To son
düşük1 = 0
düşük1_say = 0
düşük2 = 0
düşük2_say = 0
say = 0

Set fiyat = mc.Range("E" & i & ":H" & i)

düşük1 = WorksheetFunction.Min(fiyat)
düşük1_say = WorksheetFunction.CountIf(fiyat, düşük1)
say = WorksheetFunction.CountA(fiyat)
[COLOR="Red"][B]If düşük1_say < 1 Or düşük1_say = say Then[/B][/COLOR]
düşük2 = 0
düşük2_say = 0
Else
düşük2 = WorksheetFunction.Small(fiyat, düşük1_say + 1)
düşük2_say = WorksheetFunction.CountIf(fiyat, düşük2)
End If

mc.Cells(i, "AJ") = düşük1
mc.Cells(i, "AK") = düşük1_say
mc.Cells(i, "AL").FormulaArray = Evaluate("=IF(1<=" & mc.Cells(i, "AK") & ",INDEX($E$3:$AH$3,SMALL(IF($E" & i & ":$AH" & i & "=$AJ" & i & ",COLUMN($E" & i & ":$AH" & i & ")-4),1)),""Teklif Yok"")")
mc.Cells(i, "AM").FormulaArray = Evaluate("=IF(2<=" & mc.Cells(i, "AK") & ",INDEX($E$3:$AH$3,SMALL(IF($E" & i & ":$AH" & i & "=$AJ" & i & ",COLUMN($E" & i & ":$AH" & i & ")-4),2)),"""")")
mc.Cells(i, "AN").FormulaArray = Evaluate("=IF(3<=" & mc.Cells(i, "AK") & ",INDEX($E$3:$AH$3,SMALL(IF($E" & i & ":$AH" & i & "=$AJ" & i & ",COLUMN($E" & i & ":$AH" & i & ")-4),3)),"""")")
mc.Cells(i, "AO").FormulaArray = Evaluate("=IF(4<=" & mc.Cells(i, "AK") & ",INDEX($E$3:$AH$3,SMALL(IF($E" & i & ":$AH" & i & "=$AJ" & i & ",COLUMN($E" & i & ":$AH" & i & ")-4),4)),"""")")

mc.Cells(i, "AP") = düşük2
mc.Cells(i, "AQ") = düşük2_say

mc.Cells(i, "AR").FormulaArray = Evaluate("=IF(1<=" & mc.Cells(i, "AQ") & ",INDEX($E$3:$AH$3,SMALL(IF($E" & i & ":$AH" & i & "=$AP" & i & ",COLUMN($E" & i & ":$AH" & i & ")-4),1)),""Teklif Yok"")")
mc.Cells(i, "AS").FormulaArray = Evaluate("=IF(2<=" & mc.Cells(i, "AQ") & ",INDEX($E$3:$AH$3,SMALL(IF($E" & i & ":$AH" & i & "=$AP" & i & ",COLUMN($E" & i & ":$AH" & i & ")-4),2)),"""")")
mc.Cells(i, "AT").FormulaArray = Evaluate("=IF(3<=" & mc.Cells(i, "AQ") & ",INDEX($E$3:$AH$3,SMALL(IF($E" & i & ":$AH" & i & "=$AP" & i & ",COLUMN($E" & i & ":$AH" & i & ")-4),3)),"""")")
mc.Cells(i, "AU").FormulaArray = Evaluate("=IF(4<=" & mc.Cells(i, "AQ") & ",INDEX($E$3:$AH$3,SMALL(IF($E" & i & ":$AH" & i & "=$AP" & i & ",COLUMN($E" & i & ":$AH" & i & ")-4),4)),"""")")

mc.Cells(i, "AV") = WorksheetFunction.Max(fiyat)
Next

If WorksheetFunction.CountA(mc.Range("AL4:AL" & son)) > 0 Then: mc.Range("AL3") = "1. En Düşük Firma": Else mc.Range("AL3") = ""
If WorksheetFunction.CountA(mc.Range("AM4:AM" & son)) > 0 Then: mc.Range("AM3") = "2. En Düşük Firma": Else mc.Range("AM3") = ""
If WorksheetFunction.CountA(mc.Range("AN4:AN" & son)) > 0 Then: mc.Range("AN3") = "3. En Düşük Firma": Else mc.Range("AN3") = ""
If WorksheetFunction.CountA(mc.Range("AO4:AO" & son)) > 0 Then: mc.Range("AO3") = "4. En Düşük Firma": Else mc.Range("AO3") = ""

If WorksheetFunction.CountA(mc.Range("AR4:AR" & son)) > 0 Then: mc.Range("AR3") = "1. En Düşük Firma": Else mc.Range("AR3") = ""
If WorksheetFunction.CountA(mc.Range("AS4:AS" & son)) > 0 Then: mc.Range("AS3") = "2. En Düşük Firma": Else mc.Range("AS3") = ""
If WorksheetFunction.CountA(mc.Range("AT4:AT" & son)) > 0 Then: mc.Range("AT3") = "3. En Düşük Firma": Else mc.Range("AT3") = ""
If WorksheetFunction.CountA(mc.Range("AU4:AU" & son)) > 0 Then: mc.Range("AU3") = "4. En Düşük Firma": Else mc.Range("AU3") = ""

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

MsgBox "Sayfa Güncellenmiştir.", vbInformation

End Sub
İyi çalışmalar.
 
Son düzenleme:
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst