Benzersiz kayıtları listele aynı verilerin alt toplamını al

[udentr2002]

Merhaba arkadaşlar,

Ekli dosyada yapmaya çalıştığım.

Bir düğme vasıtası ile "b" stünunda (stok kodu) verilerin aynı olanlarını tek bir defa yazacak, bu aynı olan verilerin "k" stünundaki kalan miktarları toplayacak. ve

"V" stünunda ise Uyarı limiti var. yıkarıdaki işlemlewri yaptıktan sonra k stünunda mükerrer kayıtların toplam kalan miktarı aynı veriye ait V stünunda yazan değerden küçük olanları listeleyecek. Büyük olanları listelemeyecek.
Kısacası k stünu stoktaki miktarı gösteriyor, V stünu ise her bir malzemeye ait stok miktarında azalma olduğunda uyarı limitini gösteriyor. stoğumda bulunan malzemelerin uyarı limiti ile belirldiğim miktardan aşağı düştüğünde uyarı vermesini istiyorum.

Yardımcı olursanız çok sevinirim

SAYGILARIMLA

 

[bedri41]

Ekteki Dosyanızı inceleyiniz
Kolay Gelsin

 

[bedri41]

Kodların başına temizleme koymayı unutmuşum.

Range("A1:E" & [A65536].End(3).Row).ClearContents

uygun bir yere ilave edersiniz.
Kolay Gelsin

 

[udentr2002]

Hocam ilginiz ve emeğiniz için teşekkürler.

Şöyle bir sorun var benim binlerce satırım var böyle sanırım belli bir sayıdan sonrasını yapmıyor
mükerrer kayıtları süsüzp adlarını yazıyor fakat diğer stünlara #YOK şeklinde hata veriyor.

Birde sadece dikkat yazan yani stooğu azalan verileri listelese

Tekrar bakabilir misiniz hocam size zahmet

 

[bedri41]

Hocam ilginiz ve emeğiniz için teşekkürler.

Şöyle bir sorun var benim binlerce satırım var böyle sanırım belli bir sayıdan sonrasını yapmıyor
mükerrer kayıtları süsüzp adlarını yazıyor fakat diğer stünlara #YOK şeklinde hata veriyor.

Birde sadece dikkat yazan yani stooğu azalan verileri listelese

Tekrar bakabilir misiniz hocam size zahmet

Eski kodları aşağıdaki ile değiştirip deneyin

Private Sub CommandButton1_Click()
Dim syf As Worksheet
    For Each syf In Worksheets
    On Error Resume Next
       If syf.FilterMode = False Then
    Else
        syf.ShowAllData
    End If
    Next syf
    Range("A1:E" & [A65536].End(3).Row).ClearContents
    Sheets("Veri").Range("A3:A65536").Copy
    Range("A2").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("$A$2:$A$65536").RemoveDuplicates Columns:=1, Header:=xlNo
    [a1] = "Malzemenin Adı"
    [b1] = "Kalan Miktar (gr)"
    [c1] = "Uyarı Limiti"
    [d1] = "Mevcut Stok"
    [e1] = "Sonuç"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "=SUMIF(Veri!C[-1],RC[-1],Veri!C[9])"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISERROR(VLOOKUP(RC[-2],Veri!R3C1:R26C22,22,0)),"""",VLOOKUP(RC[-2],Veri!R3C1:R26C22,22,0))"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "=IF(ISERROR(RC[-2]-RC[-1]),"""",RC[-2]-RC[-1])"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "=IF(RC[-1]<RC[-2],""dikkat"","""")"
    Range("B2:E2").AutoFill Destination:=Range("B2:E" & [A65536].End(3).Row), Type:=xlFillDefault
    Range("$A$1:$E$65536").AutoFilter Field:=5, Criteria1:="<>"
    Range("A1").Select
    Cells.EntireColumn.AutoFit
End Sub

Kolay Gelsin

 

[udentr2002]

Hocam teşekkürler
elinize emeğinize bilginize sağlık. Dosyama uyarlıyorum şimdi