Maksimum değeri filtreleyen kod yardımı

[EMREKAYA]

Arkadaşlar Merhaba,

Aylık stok giriş çıkışlarında en yüksek seviyeyi filtrelemek istiyorum. Bunun için ekte bir dosya var ve senaryo şöyle;

Sayfa1 den B sutunundan(Malzeme Sınıfı Kodu) ndan okusun, aynı kodların içerisinde I sutununda(Toplam) değeri en yüksek olan satırı alsın. Sayfa2 ye tek satır olarak yazsın. Tüm satır bilgileri gelirse daha iyi olur.

Bu rapor sonucunda her kod tan tek bir satırda en yüksek toplam değerini görmüş olacağım.

Yalnız şöyle bir istisna olabilir. Aynı kodta farklı satırlarda en büyük değer eşit olabilir. O zaman aynı kod için iki satır peşpeşe gelebilir. Bu engellensede olur engellenmesede olur.

Bunu gerçekleştirecek bir makro kodu yazılabilirse sevinirm.

şimdiden teşekkürler...

 

[İhsan Tank]

illa makro mu olacak formül olsa olmaz mı_?
olur ise.
sorunuza bir örnek verir misiniz
siz sayfa1'deki en yüksek değere göre mi veriler gelecek yoksa sizin seçtiğiniz bir verinin en yüksek değeri mi gelecek hücreye. söylerseniz formül ile yapmaya çalışayım

 

[EMREKAYA]

Sayfa 1 i verideposu olarak kabul edersek sayfa2 deki gibi bir sıralama olması gerekiyor.

Aynı malzeme kodundan birden fazla satır olabilir.2,5,15,20 satır gibi...

5 tane varsa bunların arasındaki en yüksek toplam değerine sahip satırı alsın istiyorum.

Böylelikle tek sayfada her malzeme kodunun en yüksek seviyedekini elde etmiş bir sayfa elde etmiş olacağım.

Makro ile olursa düzenlemeye fazla gerek kalmaz diye öyle istedim. Liste uzun çünkü...

Ama mümkün değilse formülle de olur...

Teşekkür ederim

 

[EMREKAYA]

ilk mesajımda ekli dosyaya bakabilirsiniz.

sayfa1 deki dataları sayfa2 de nasıl görmek istediğimi yazdım, manuel olarak birkaç satır...

 

[İhsan Tank]

ilk mesajımda ekli dosyaya bakabilirsiniz.

sayfa1 deki dataları sayfa2 de nasıl görmek istediğimi yazdım, manuel olarak birkaç satır...

merhaba
sizin istediğiniz malzeme koduna göre olacak diye anladım ve bir formül yazdım
sayfa2'nin I2 satırına

=MAK(EĞER(Sayfa1!$B$2:$B$[COLOR="Red"]2000[/COLOR]=Sayfa2!$B2;Sayfa1!$I$2:$I$[COLOR="red"]2000[/COLOR]))

bu formülü yazıp ctrl+shift+enter tuş kombinasyonu ile aktif ettiğiniz takdirde işlem yapacaktır.
formül dizi formülüdür. ctrl+shift+enter tuş kombinasyonu ile aktif olmaktadır.
formülün başında ve sonunda

{ }

bu işaretler çıkacaktır. bu işaretleri elle koyduğunuz takdirde hata verir formül çalışmaz.
not : formüller 2000 satıra kadar yapılmıştır. kırmızı yerleri kendinize göre ayarlayınız
yapamazsanız dosya ekliyebilirim

 

[Korhan Ayhan]

Selamlar,

Alternatif olarak aşağıdaki kodu kullanabilirsiniz.

Option Explicit
 
Sub MAKSİMUM_SEVİYELERİ_LİSTELE()
    Dim S1 As Worksheet, S2 As Worksheet
    Dim X As Long, BUL As Range, Son_Satır As Long
 
    Set S1 = Sheets("Sayfa1")
    Set S2 = Sheets("Sayfa2")
 
    S2.Cells.Clear
    Son_Satır = S1.Range("A65536").End(3).Row
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    S1.Range("J2").Formula = "=B2&C2&D2&I2"
    S1.Range("J2").AutoFill Destination:=S1.Range("J2:J" & Son_Satır)
 
    S1.Columns("A:D").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=S2.Range("A1"), Unique:=True
    S1.Range("A1:I1").Copy S2.Range("A1")
    S2.Range("J2").Formula = "=B2&C2&D2&I2"
    S2.Range("J2").AutoFill Destination:=S2.Range("J2:J" & Son_Satır)
    S2.Range("I2:I" & S2.Range("A65536").End(3).Row).Formula = "=SUMPRODUCT(MAX((Sayfa1!B$2:B$" & Son_Satır & "=B2)*(Sayfa1!C$2:C$" & Son_Satır & "=C2)*(Sayfa1!I$2:I$" & Son_Satır & ")))"
    S2.Range("I2:I" & S2.Range("A65536").End(3).Row).Value = S2.Range("I2:I" & S2.Range("A65536").End(3).Row).Value
 
    For X = 2 To S2.Range("A65536").End(3).Row
        Set BUL = S1.Range("J:J").Find(S2.Cells(X, "J"), LookIn:=xlValues)
        If Not BUL Is Nothing Then
            S2.Range("E" & X & ":H" & X).Value = S1.Range("E" & BUL.Row & ":H" & BUL.Row).Value
        End If
    Next
 
    S2.Range("A1:I" & S2.Range("A65536").End(3).Row).Borders.LineStyle = 1
    S1.Columns("J:J").Clear
    S2.Columns("J:J").Clear
    S2.Cells.EntireColumn.AutoFit
    S2.Columns("A:I").ColumnWidth = 100
    S2.Cells.EntireRow.AutoFit
    S2.Cells.EntireColumn.AutoFit
 
    S2.Range("A2:I65536").Sort Key1:=S2.Range("A2"), Order1:=xlAscending, Key2:=S2.Range("B2") _
    , Order2:=xlAscending, Key3:=S2.Range("C2"), Order3:=xlAscending, Header:= _
    xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal, DataOption2:=xlSortNormal, DataOption3:=xlSortNormal
 
    S2.Select
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
    Set S1 = Nothing
    Set S2 = Nothing
    Set BUL = Nothing
 
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[EMREKAYA]

Teşekkürler İhsan Tank ve Korhan Ayhan ...

 

[İhsan Tank]

Teşekkürler İhsan Tank ve Korhan Ayhan ...

rica ederim
ayrıca Korhan Ayhan Hocam'ada alternatif ürettiği için teşekkür ederim
iyi çalışmalar :mutlu: