• DİKKAT

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

Soru Excell depolardaki stokları listeleme

Ü

ümit bektas

Altın Üye
Katılım
12 Eylül 2021
Mesajlar
54
Excel Vers. ve Dili
Microsoft Office 2016 Türkçe
Selamlar,

ürün adına göre, bütün bölgelerdeki aynı ürünleri eksik ve fazlasını toplayıp kalan adeti yeni bir sayfada yazmasını yapamadım. Bilen arkadaşların yardımını rica ederim..
Örnek,244365
 

Ekli dosyalar

Selam, eğer doğru anladım ise örnekteki formülleri inceleyebilirsiniz
 

Ekli dosyalar

Merhaba,

Dosya ekte mevcuttur

C#: 
Sub ozet()
             
   
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
               
    Set S1 = Sheets("DATA")
    Set S2 = Sheets("RAPOR")
    Set Dizi = CreateObject("Scripting.Dictionary")
               
    S2.Range("A2:C" & 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 3)
               
    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, 2)
                Liste(Say, 2) = Veri(X, 11)
                If Veri(X, 11) < 0 Then
                Liste(Say, 3) = "fazla"
                Else
                Liste(Say, 3) = "eksik"
                End If
            Else
                Liste(Dizi.Item(Aranan), 2) = Liste(Dizi.Item(Aranan), 2) + Veri(X, 11)
                If Liste(Dizi.Item(Aranan), 2) < 0 Then
                Liste(Dizi.Item(Aranan), 3) = "fazla"
                Else
                Liste(Dizi.Item(Aranan), 3) = "eksik"
                End If
               
            End If
           
    Next
    If Say > 0 Then
                       
        S2.Range("A2").Resize(Say, 3) = Liste
        S2.Range("A2").Resize(Say, 3).Sort S2.Range("A2"), xlAscending
                   
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
                   
    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
 

Ekli dosyalar

Son düzenleme:
Elinize sağlık.

Set Dizi = CreateObject("Scripting.Dictionary")

bu kodun ne işe yaradığını söylemeniz mümkün mü acaba ?
 
maliex' Alıntı:
Merhaba,

Dosya ekte mevcuttur

C#: 
Sub ozet()
            
  
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
              
    Set S1 = Sheets("DATA")
    Set S2 = Sheets("RAPOR")
    Set Dizi = CreateObject("Scripting.Dictionary")
              
    S2.Range("A2:C" & 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 3)
              
    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, 2)
                Liste(Say, 2) = Veri(X, 11)
                If Veri(X, 11) < 0 Then
                Liste(Say, 3) = "fazla"
                Else
                Liste(Say, 3) = "eksik"
                End If
            Else
                Liste(Dizi.Item(Aranan), 2) = Liste(Dizi.Item(Aranan), 2) + Veri(X, 11)
                If Liste(Dizi.Item(Aranan), 2) < 0 Then
                Liste(Dizi.Item(Aranan), 3) = "fazla"
                Else
                Liste(Dizi.Item(Aranan), 3) = "eksik"
                End If
              
            End If
          
    Next
    If Say > 0 Then
                      
        S2.Range("A2").Resize(Say, 3) = Liste
        S2.Range("A2").Resize(Say, 3).Sort S2.Range("A2"), xlAscending
                  
        Application.Calculation = xlCalculationAutomatic
        Application.ScreenUpdating = True
                  
    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
Genişletmek için tıkla ...
Çok teşekkür ederim. İstediğim gibi olmuş. Bunu Mülkiyet sahibine göre düzenleye bilirmiyiz. Örneğin Etinin malzemesi ülkerin malzemesine karışmaması gerekiyor.
 
Merhaba, kodları aşağıdaki gibi güncelleyiniz

C#: 
Sub ozet()
               
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
               
    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) & Veri(X, 1)
            If Not Dizi.Exists(Aranan) Then
                Say = Say + 1
                Dizi.Add Aranan, Say
                Liste(Say, 1) = Veri(X, 2)
                Liste(Say, 2) = Veri(X, 11)
                If Veri(X, 11) < 0 Then
                Liste(Say, 3) = "fazla"
                Else
                Liste(Say, 3) = "eksik"
                End If
                Liste(Say, 4) = Veri(X, 1)
            Else
                Liste(Dizi.Item(Aranan), 2) = Liste(Dizi.Item(Aranan), 2) + Veri(X, 11)
                If Liste(Dizi.Item(Aranan), 2) < 0 Then
                Liste(Dizi.Item(Aranan), 3) = "fazla"
                Else
                Liste(Dizi.Item(Aranan), 3) = "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
                   
    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
 

Ekli dosyalar

Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst