Kritere göre listedeki minimum fiyatın getirilmesi

[sakoz]

Arkadaşlar Merhaba ,

Ekli dosyada bir listemiz var. Bu listede A sütununda SN var. SN numarası aynı olan satırların I sütununda NET FIYAT 'ları var.

Bizim istediğimiz aynı SN numarası olan satırlardaki en düşük NET FIYAT 'ı alıp gri olan satırın devamındaki K sütununa bunu yazdırmak. I sütununda fiyat bilgisi olmayanlardada FIYAT YOK mesajı yazdırmak.

Örnek dosyayı ekliyorum. Dosyada K sütununda olması gerekenleri birkaç örnekle verdim.

http://s5.dosya.tc/server5/khh8yp/min_ornek.rar.html

Yardımcı olursanız çok memnun olurum. Gerçekten yardımınıza ihtiyacım var.
Saygılar,

 

[Ziynettin]

Merhaba,

Aşağıdaki kodu deneyiniz.

Option Explicit
Sub kucukleri_listele()
Dim a(), b(), d As Object, deg, d1 As Object
Dim i As Long, z As Double
z = TimeValue(Now)
On Error Resume Next
a = Range("A2:I" & Cells(Rows.Count, 1).End(3).Row)
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
For i = 1 To UBound(a)
    deg = a(i, 1)
    If a(i, 9) <> "" Then
        If d.exists(deg) Then
            If a(i, 9) < a(d(deg), 9) Then d(deg) = i
        Else
            d(deg) = i
        End If
    End If
    d1(deg) = d1(deg) + 1
Next i
ReDim b(1 To UBound(a), 1 To 1)
For i = 1 To UBound(a)
    deg = a(i, 1)
    If a(i, 9) = "" Then b(i, 1) = a(d(deg), 9)
    If d1(deg) = 1 Then b(i, 1) = "FIYAT YOK"
Next i
[K2].Resize(UBound(a)) = b
MsgBox "      İşlem tamam...." & vbLf & vbLf & "İşlem süreniz ; " & _
CDate(TimeValue(Now) - z), vbInformation
End Sub

 

[sakoz]

Ziynettin Bey ,

Ellerinize sağlık , kod mükemmel ve çok hızlı bir şekilde çalışıyor.
Emeğinize sağlık...

Birde minimum fiyatın olduğu satırdaki marka ve firma bilgisinide L ve M sütununa getirtme şansımız varmıdır acaba ?
Şimdiden teşekkürler...

 

[Ziynettin]

Ziynettin Bey ,

Ellerinize sağlık , kod mükemmel ve çok hızlı bir şekilde çalışıyor.
Emeğinize sağlık...

Birde minimum fiyatın olduğu satırdaki marka ve firma bilgisinide L ve M sütununa getirtme şansımız varmıdır acaba ?
Şimdiden teşekkürler...

Option Explicit
Sub kod_1()
Dim a(), b(), d As Object, deg, d1 As Object
Dim i As Long, z As Double
z = TimeValue(Now)
On Error Resume Next
a = Range("A2:J" & Cells(Rows.Count, 1).End(3).Row)
Set d = CreateObject("scripting.dictionary")
Set d1 = CreateObject("scripting.dictionary")
For i = 1 To UBound(a)
    deg = a(i, 1)
    If a(i, 9) <> "" Then
        If d.exists(deg) Then
            If a(i, 9) < a(d(deg), 9) Then d(deg) = i
        Else
            d(deg) = i
        End If
    End If
    d1(deg) = d1(deg) + 1
Next i
ReDim b(1 To UBound(a), 1 To 3)
For i = 1 To UBound(a)
    deg = a(i, 1)
    If a(i, 9) = "" Then
        b(i, 1) = a(d(deg), 9)
        b(i, 2) = a(d(deg), 6)
        b(i, 3) = a(d(deg), 10)
    End If
    If d1(deg) = 1 Then b(i, 1) = "FIYAT YOK"
Next i
[K2].Resize(UBound(a), 3) = b
MsgBox "      İşlem tamam...." & vbLf & vbLf & "İşlem süreniz ; " & _
CDate(TimeValue(Now) - z), vbInformation
End Sub

 

[sakoz]

Süpersiniz valla , benim sormamla sizin cevaplamanız arasında zaman yok neredeyse
Çok teşekkür ederim hocam... Elinize , emeğinize sağlık...

 

[burcin_end_muh]

değişken aralıkta min ve max bulma ama formülle

merhaba,

bu konunun devamı olarak gördüğüm için buraya ekleme gereği hissettim.
Elimde mağazada çalışanların giriş çıkış saatlerinin bulunduğu bir liste var.
bir mağazada kıdemi 6 dan küçük olanların(yönetici olduğunun belirten şart) arasındaki en küçük giriş saatini ve aynısının en büyük çıkış saatini bulmak istiyorum.(formülle)
a ve b sütuna getirmek istiyorum. yani aynı mağazada aynı değer mağaza ve kıdem katsayısı değişene kadar yazması normal.

Teşekkürler şimdiden

 

[Haluk]

Tam anlamadım ama, anladığım kadarıyla kıdemi 6'dan küçük olanlar arasında en erken işe başlama ve en geç işten çıkma saatleri için dosyanız ektedir...

.

 

[Haluk]

X ve Y mağazalarına ait ayrı ayrı bilgiler için ekli alternatif dosyalara bakınız. (Kıdem sayısı 6'dan küçük olan kişiler için)

Not: Formüller dizi formülüdür, yani Ctrl+Shift+Enter ile girilmiştir. Orjinal dosyanıza uygulayacaksanız buna dikkat edin.

.

 

[burcin_end_muh]

X ve Y mağazalarına ait ayrı ayrı bilgiler için ekli alternatif dosyalara bakınız. (Kıdem sayısı 6'dan küçük olan kişiler için)

Not: Formüller dizi formülüdür, yani Ctrl+Shift+Enter ile girilmiştir. Orjinal dosyanıza uygulayacaksanız buna dikkat edin.

.

*DÜZELTME sanırım az önce doğru uygulamamışım, şuan düzgün çalışıyor, tekrar çok teşekkürler.

Merhaba Haluk Bey,

Öncelikle çok teşekkür ederim yardımlarınız için. formül eksiksiz çalışıyor.
Şimdi şunu eklemeye çalıştım ama olmadı.
Bu dizi formülü sadece yöneticilerin önünde çalışsın dedim ama olmadı.
Dizi formülünün dışına eğer kıdem<6 ekledim çalışmadı bu konuda bir çözüm var mı acaba?

 

[Haluk]

Şimdi şunu eklemeye çalıştım ama olmadı.
Bu dizi formülü sadece yöneticilerin önünde çalışsın dedim ama olmadı.

Revize dosya ektedir...


.

 

[Haluk]

10. mesajdaki dosya yenilenmiştir.

.