• DİKKAT

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

en avantajlı firma bulma

sirkülasyon

Altın Üye
Katılım
10 Temmuz 2012
Mesajlar
2,543
Excel Vers. ve Dili
2021 LTSC TR
Makro ile düğme müğme eklenmeden otomotik olarak
1.olan en avantajlı firmanın
adını G33 hücresine
adresini k33 Hücresine
Fiyatını p33 hücresine

2.olan en avantajlı firmanın
adını G34 hücresine
adresini k34 Hücresine
Fiyatını p34 hücresine


Kazanan 1.olan firma oldu ya bu sefer bilgilerini
1.olan en avantajlı firmanın
adını G35 hücresine
adresini k35 Hücresine
Fiyatını p35 hücresine yazmak istiyorum.
Ama makroyla.
Abilerime şimdiden teşekkür ederim.





Necip Fazıl Üstadın bir şiiri paylaşmak istedim. Valla beğendim sizlerinde okumasını istedim.
O erler ki, gönül fezasındalar,
Toprakta sürünme ezasındalar.

Yıldızları tesbih tesbih çeker de,
Namazda arka saf hizasındalar.

İçine nefs sızan ibadetlerin,
Bir biri ardınca kazasındalar.

Günü her dem dolup her dem başlayan,
Ezel senedin imzasındalar.

Bir ân yabancıya kaysa gözleri,
Bir ömür gözyaşı cezasındalar.

Her rengi silici aşk ötesinde renk;
O rengin kavuran beyasındalar.

Ne cennet tasası ve ne cehennem;
Sadece Allah ' ın rızasındalar.
 

Ekli dosyalar

Merhaba,

Aşağıdkai kodu sayfanızın kod bölümüne uygulayıp deneyiniz.

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set Alan = Union(Range("K10:K29"), Range("M10:M29"), Range("O10:O29"))
    
    Fiyat_1 = WorksheetFunction.Small(Alan, 1)
    Fiyat_2 = WorksheetFunction.Small(Alan, 2)
    
    Set Bul = Alan.Find(Fiyat_1, , , xlWhole)
    Range("G33") = Cells(7, Bul.Column)
    Range("K33") = Cells(8, Bul.Column)
    Range("P33") = Fiyat_1
    
    Set Bul = Alan.Find(Fiyat_2, , , xlWhole)
    Range("G34") = Cells(7, Bul.Column)
    Range("K34") = Cells(8, Bul.Column)
    Range("P34") = Fiyat_2
    
    Range("G35") = Cells(7, Bul.Column)
    Range("K35") = Cells(8, Bul.Column)
    Range("P35") = Fiyat_1
    
    Set Bul = Nothing
    Set Alan = Nothing
End Sub
 
Korhan Abi
toplam fiyatın yer aldığı L30;N30;P30 hücrelerini görse bu tutara göre ekonomik açıdan en avantajlı firmayı belirlese bu belirlemeye göre Firmanın adını adresini ve tutarını yazması şeklinde bir talebim olsa yardımcı olabilir misiniz?

Şu an ki haliyle
en avantajlı birinci firma
ikinci en avantajlı birinci firma çıkıyor
 
Merhaba,

Aşağıdaki kodu deneyiniz.

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set Alan = Union(Range("L10:L29"), Range("N10:N29"), Range("P10:P29"))
    
    Fiyat_1 = Format(WorksheetFunction.Small(Alan, 1), "#,##0.00")
    Fiyat_2 = Format(WorksheetFunction.Small(Alan, 2), "#,##0.00")
    
    Set Bul = Alan.Find(CDbl(Fiyat_1), , xlValues, xlPart)
    Range("G33") = Cells(7, Bul.Column - 1)
    Range("K33") = Cells(8, Bul.Column - 1)
    Range("P33") = CDbl(Fiyat_1)
    
    Set Bul = Alan.Find(CDbl(Fiyat_2), , xlValues, xlPart)
    Range("G34") = Cells(7, Bul.Column - 1)
    Range("K34") = Cells(8, Bul.Column - 1)
    Range("P34") = CDbl(Fiyat_2)
    
    Range("G35") = Cells(7, Bul.Column - 1)
    Range("K35") = Cells(8, Bul.Column - 1)
    Range("P35") = CDbl(Fiyat_1)
    
    Set Bul = Nothing
    Set Alan = Nothing
End Sub
 
Korhan Abi
Ekonomik Açıdan en avantajlı Birinci Firma 10.710,00 TL İle A FİRMASI
Ekonomik Açıdan en avantajlı İkinci Firma 12.67,00 TL İle B FİRMASI çıkması lazım gelir iken farklı çıkıyor.

Kişilerin / Firmaların Teklifleri Toplamı ( KDV HARİÇ ) satırında TOPLAM TUTAR'lara bakarak makro işlem yapması istirhamımdır
Korhan Abi zahmet veriyorum. Hakkını helal et vallaha.
Ne olur kızmayın bu gardaşınıza
 

Ekli dosyalar

Pardon ben #3 nolu mesajınızı farklı yorumlamışım. Aşağıdaki kodu deneyiniz.

Kod:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Set Alan = Union(Range("L30"), Range("N30"), Range("P30"))
    
    Fiyat_1 = Format(WorksheetFunction.Small(Alan, 1), "#,##0.00")
    Fiyat_2 = Format(WorksheetFunction.Small(Alan, 2), "#,##0.00")
    
    For Each Veri In Alan
        If Veri.Value = CDbl(Fiyat_1) Then
            Range("G33") = Cells(7, Veri.Column - 1)
            Range("K33") = Cells(8, Veri.Column - 1)
            Range("P33") = CDbl(Fiyat_1)
            Range("G35") = Cells(7, Veri.Column - 1)
            Range("K35") = Cells(8, Veri.Column - 1)
            Range("P35") = CDbl(Fiyat_1)
        End If
        
        If Veri.Value = CDbl(Fiyat_2) Then
            Range("G34") = Cells(7, Veri.Column - 1)
            Range("K34") = Cells(8, Veri.Column - 1)
            Range("P34") = CDbl(Fiyat_2)
        End If
    Next
    
    Set Alan = Nothing
End Sub
 
Korhan Abi makroyu bir kaç kere anlatamamam yüzünden değiştirmek zorunda kaldınız. Buna rağmen sabır gösterip, yardımınızı esirgemediğiniz için teşekkür ederim.
 
Geri
Üst