Soru stok mülkiyeti getirme

[ümit bektas]

selamlar,

rapor sayfasına stok mülkiyetini nasıl getire bilirim.

 

[Korhan Ayhan]

Deneyiniz.

Option Explicit

Sub Ozet_Rapor()
    Dim S1 As Worksheet, S2 As Worksheet, Dizi As Object, Zaman As Double
    Dim Son As Long, Veri As Variant, X As Long, Aranan As String, Say As Long

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
                
    Zaman = Timer
                
    Set S1 = Sheets("DATA")
    Set S2 = Sheets("RAPOR")
    Set Dizi = CreateObject("Scripting.Dictionary")
                
    S2.Range("A2:D" & S2.Rows.Count).Clear
    Son = S1.Cells(S1.Rows.Count, 1).End(3).Row
    Veri = S1.Range("A2:K" & Son).Value
                
    ReDim Liste(1 To Son, 1 To 4)
                
    For X = LBound(Veri) To UBound(Veri)
        Aranan = Veri(X, 2)
        If Not Dizi.Exists(Aranan) Then
            Say = Say + 1
            Dizi.Add Aranan, Say
            Liste(Say, 1) = Veri(X, 4)
            Liste(Say, 2) = Veri(X, 2)
            Liste(Say, 3) = Veri(X, 11)
            If Veri(X, 11) < 0 Then
                Liste(Say, 4) = "Fazla"
            Else
                Liste(Say, 4) = "Eksik"
            End If
        Else
            Liste(Dizi.Item(Aranan), 3) = Liste(Dizi.Item(Aranan), 3) + Veri(X, 11)
            If Liste(Dizi.Item(Aranan), 3) < 0 Then
                Liste(Dizi.Item(Aranan), 4) = "Fazla"
            Else
                Liste(Dizi.Item(Aranan), 4) = "Eksik"
            End If
        End If
    Next
    
    If Say > 0 Then
        S2.Range("A2").Resize(Say, 4) = Liste
        S2.Range("A2").Resize(Say, 4).Sort S2.Range("A2"), xlAscending
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbExclamation
    Else
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
        MsgBox "Veri bulunamadı!" & Chr(10) & Chr(10) & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbExclamation
    End If
                
    Set S1 = Nothing
    Set S2 = Nothing
    Set Dizi = Nothing
End Sub

 

[ümit bektas]

@Korhan Ayhan Bey,




çıkacak sonuç bu şekilde olmalıydı.

 

[ümit bektas]

Nasıl revize ede bilirim

If Not Dizi.Exists(Aranan) Then
Say = Say + 1
Dizi.Add Aranan, Say

Liste(Say, 1) = Veri(X, 4) 'stok Mülkiyeti
Liste(Say, 2) = Veri(X, 2) 'ürün adı
Liste(Say, 3) = Veri(X, 11) 'DEPO STOK DURUMU FAZLA



If Veri(X, 11) < 0 Then
Liste(Say, 4) = "Fazla" 'açıklama yazma fazla
Else
Liste(Say, 4) = "Eksik" 'açıklama yazma eksik
End If
Else
Liste(Dizi.Item(Aranan), 3) = Liste(Dizi.Item(Aranan), 3) + Veri(X, 11) 'veri toplama

 

[Haluk]

Pivot Tablo ....


.