Soru Excell depolardaki stokları listeleme

Ü

ümit bektas

Katılım
12 Eylül 2021
Mesajlar
45
Excel Vers. ve Dili
Microsoft Office 2016 Türkçe
Altın Üyelik Bitiş Tarihi
01-03-2024
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

X

xtrkax

Katılım
16 Temmuz 2014
Mesajlar
74
Excel Vers. ve Dili
2010 TR
Altın Üyelik Bitiş Tarihi
13-04-2024
Selam, eğer doğru anladım ise örnekteki formülleri inceleyebilirsiniz
 

Ekli dosyalar

maliex

maliex

Altın Üye
Katılım
22 Eylül 2019
Mesajlar
227
Excel Vers. ve Dili
professional plus 2016-türkçe
Altın Üyelik Bitiş Tarihi
23-09-2025
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:
M

musculus2

Altın Üye
Altın Üye
Katılım
23 Şubat 2007
Mesajlar
112
Excel Vers. ve Dili
2013 türkçe
Altın Üyelik Bitiş Tarihi
09-06-2027
Elinize sağlık.

Set Dizi = CreateObject("Scripting.Dictionary")

bu kodun ne işe yaradığını söylemeniz mümkün mü acaba ?
 
Ü

ümit bektas

Katılım
12 Eylül 2021
Mesajlar
45
Excel Vers. ve Dili
Microsoft Office 2016 Türkçe
Altın Üyelik Bitiş Tarihi
01-03-2024
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.
 
Ü

ümit bektas

Katılım
12 Eylül 2021
Mesajlar
45
Excel Vers. ve Dili
Microsoft Office 2016 Türkçe
Altın Üyelik Bitiş Tarihi
01-03-2024
Lütfen bilen varsa yardım etsin
 
maliex

maliex

Altın Üye
Katılım
22 Eylül 2019
Mesajlar
227
Excel Vers. ve Dili
professional plus 2016-türkçe
Altın Üyelik Bitiş Tarihi
23-09-2025
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.
Üst