Tablonun sadeleştirilmesi

sezgin06 · 2 Kasım 2021

Merhaba;

Örnek dosyadaki ilk tabloya yapılacak işlemler giriliyor , makro yardımıyla 2 ve 3 ncü tabloda kalan ürün, miktarı ve ağırlıklı ortalama fiyatı bulunuyor.

Daha anlaşılır ve sade olması amacıyla mavi tabloyu, M sütununu da iptal ederek , verilerini elle girdiğim yeşil tablo gibi, makroda değişiklik yapmak suretiyle düzenleyebilir miyiz?

Ziynettin · 2 Kasım 2021

Merhaba.

Konuya hakim değilim yeşil tabloya göre uyarlamaya çalıştım. Umarım olur.

sezgin06 · 2 Kasım 2021

Ziynettin' Alıntı:
Merhaba.

Konuya hakim değilim yeşil tabloya göre uyarlamaya çalıştım. Umarım olur.

Ziynettin bey teşekkür ederim süper... Emeğinize desteğinize sağlık,iyi akşamlar diliyorum.

sezgin06 · 2 Kasım 2021

sezgin06' Alıntı:
Ziynettin bey teşekkür ederim süper... Emeğinize desteğinize sağlık,iyi akşamlar diliyorum.

Tekrar merhaba,
Tabloyu detaylı incelediğimde yerleşim ve mevcut değişiminde problem yok yalnız ağırlıklı ortalama hesabında makro işlem yapmıyor, bakma imkanınız olursa sevinirim...Teşekkür ederim

sezgin06 · 3 Kasım 2021

sezgin06' Alıntı:
Tekrar merhaba,
Tabloyu detaylı incelediğimde yerleşim ve mevcut değişiminde problem yok yalnız ağırlıklı ortalama hesabında makro işlem yapmıyor, bakma imkanınız olursa sevinirim...Teşekkür ederim

Konunun daha anlaşılır olması adına örnek dosyayı inceleyebilirsiniz

sezgin06 · 3 Kasım 2021

sezgin06' Alıntı:
Konunun daha anlaşılır olması adına örnek dosyayı inceleyebilirsiniz

Merhaba,

Mevcut makronun işlem konusunda problemi yok, değişikliği istenen, M sütununun iptal edilerek mavi tablonun yeşil olanın şekline çevrilmesi, yani R sütununda boş olan hücrelerin satırının silinmesi. Yardımcı olursanız sevinirim, teşekkürler...

Ziynettin · 3 Kasım 2021

#5. iletideki ekli dosyanıza ait çalışma.

Kod:

Sub test()
son = Cells(Rows.Count, 2).End(3).Row
a = Range("B1:F" & son).Value
Set dc = CreateObject("scripting.dictionary")
ReDim b(1 To UBound(a), 1 To 5)
ReDim c(1 To UBound(a), 1 To 5)

For i = 2 To UBound(a)
    krt = a(i, 2)
    If Not dc.exists(krt) Then
    
        dc(krt) = dc.Count + 1
        Say = dc.Count
        b(Say, 1) = krt
        
        If a(i, 1) = "Alış" Then
            b(Say, 2) = a(i, 4)
            b(Say, 5) = CDbl(a(i, 5))
         End If
            
        If a(i, 1) = "Satış" Then
            b(Say, 3) = a(i, 4)
        End If
        
    Else
    
        Say = dc(krt)
        If a(i, 1) = "Alış" Then
            b(Say, 2) = b(Say, 2) + a(i, 4)
            b(Say, 5) = b(Say, 5) + CDbl(a(i, 5))
        End If
        
        If a(i, 1) = "Satış" Then
            b(Say, 3) = b(Say, 3) + a(i, 4)
        End If
        
    End If
    
    b(Say, 4) = b(Say, 2) - b(Say, 3)
    
Next i

For i = 1 To dc.Count
    If b(i, 4) <> 0 Then
        n = n + 1
        c(n, 1) = b(i, 1)
        c(n, 2) = b(i, 2)
        c(n, 3) = b(i, 3)
        c(n, 4) = CDbl(b(i, 4))
        c(n, 5) = CDbl(b(i, 5)) / CDbl(b(i, 2))
    End If
Next i

Range("O2:S" & Rows.Count).ClearContents
Range("O2:S" & Rows.Count).ClearFormats
[O2].Resize(n, 5).Borders.Color = rgbSilver
[S2].Resize(n).NumberFormat = "#,##0.00"
[O2].Resize(n, 5) = c

MsgBox "İşlem bitti...", vbInformation
End Sub

sezgin06 · 3 Kasım 2021

Ziynettin' Alıntı:

#5. iletideki ekli dosyanıza ait çalışma.

Kod:

Sub test()
son = Cells(Rows.Count, 2).End(3).Row
a = Range("B1:F" & son).Value
Set dc = CreateObject("scripting.dictionary")
ReDim b(1 To UBound(a), 1 To 5)
ReDim c(1 To UBound(a), 1 To 5)

For i = 2 To UBound(a)
    krt = a(i, 2)
    If Not dc.exists(krt) Then
   
        dc(krt) = dc.Count + 1
        Say = dc.Count
        b(Say, 1) = krt
       
        If a(i, 1) = "Alış" Then
            b(Say, 2) = a(i, 4)
            b(Say, 5) = CDbl(a(i, 5))
         End If
           
        If a(i, 1) = "Satış" Then
            b(Say, 3) = a(i, 4)
        End If
       
    Else
   
        Say = dc(krt)
        If a(i, 1) = "Alış" Then
            b(Say, 2) = b(Say, 2) + a(i, 4)
            b(Say, 5) = b(Say, 5) + CDbl(a(i, 5))
        End If
       
        If a(i, 1) = "Satış" Then
            b(Say, 3) = b(Say, 3) + a(i, 4)
        End If
       
    End If
   
    b(Say, 4) = b(Say, 2) - b(Say, 3)
   
Next i

For i = 1 To dc.Count
    If b(i, 4) <> 0 Then
        n = n + 1
        c(n, 1) = b(i, 1)
        c(n, 2) = b(i, 2)
        c(n, 3) = b(i, 3)
        c(n, 4) = CDbl(b(i, 4))
        c(n, 5) = CDbl(b(i, 5)) / CDbl(b(i, 2))
    End If
Next i

Range("O2:S" & Rows.Count).ClearContents
Range("O2:S" & Rows.Count).ClearFormats
[O2].Resize(n, 5).Borders.Color = rgbSilver
[S2].Resize(n).NumberFormat = "#,##0.00"
[O2].Resize(n, 5) = c

MsgBox "İşlem bitti...", vbInformation
End Sub

Ziynettin bey öncelikle ilginize teşekkür ederim,bu makroda da ağırlıklı ortalama hesabında hatalı sonuç veriyor. Farklı zaman,miktar ve fiyattan alınan ve satılan aynı ürün girildiğinde.Sizin makroyu uyarladım şimdiki dosyaya,#5.iletideki dosyaya aynı ürün hareketlerini aktardığımızda fark edeceksiniz.

dost · 4 Kasım 2021

Merhaba,

Yürüyen ağırlıklı ortalama istiyorsunuz galiba.
Sayın Ziynettin'in affına sığınarak gerekli revizeyi yaptım.

C++:

Sub test()
son = Cells(Rows.Count, 2).End(3).Row
a = Range("B1:F" & son).Value
Set dc = CreateObject("scripting.dictionary")
ReDim b(1 To UBound(a), 1 To 5)
ReDim c(1 To UBound(a), 1 To 5)

For i = 2 To UBound(a)
    krt = a(i, 2)
    If Not dc.exists(krt) Then
   
        dc(krt) = dc.Count + 1
        Say = dc.Count
        b(Say, 1) = krt
       
        If a(i, 1) = "Alış" Then
            b(Say, 2) = a(i, 4)
            b(Say, 5) = CDbl(a(i, 5))
         End If
           
        If a(i, 1) = "Satış" Then
            b(Say, 3) = a(i, 4)
        End If
       
    Else
   
        Say = dc(krt)
        If a(i, 1) = "Alış" Then
            b(Say, 2) = b(Say, 2) + a(i, 4)
            b(Say, 5) = b(Say, 5) + CDbl(a(i, 5))
        End If
       
        If a(i, 1) = "Satış" Then
            b(Say, 5) = b(Say, 5) - (b(Say, 5) / b(Say, 4) * a(i, 4))      'Devir Tutarı - (Devir Tutarı / Devir Miktarı * Satış Miktarı)
            b(Say, 3) = b(Say, 3) + a(i, 4)
           
        End If
       
    End If
   
    b(Say, 4) = b(Say, 2) - b(Say, 3)
   
Next i

For i = 1 To dc.Count
    If b(i, 4) <> 0 Then
        n = n + 1
        c(n, 1) = b(i, 1)
        c(n, 2) = b(i, 2)
        c(n, 3) = b(i, 3)
        c(n, 4) = CDbl(b(i, 4))
        c(n, 5) = CDbl(b(i, 5)) / CDbl(b(i, 4))      'Devir Tutarı / Devir Miktarı
    End If
Next i

Range("O2:S" & Rows.Count).ClearContents
Range("O2:S" & Rows.Count).ClearFormats
[O2].Resize(n, 5).Borders.Color = rgbSilver
[S2].Resize(n).NumberFormat = "#,##0.00"
[O2].Resize(n, 5) = c

MsgBox "İşlem bitti...", vbInformation
End Sub

sezgin06 · 4 Kasım 2021

dost' Alıntı:

Merhaba,

Yürüyen ağırlıklı ortalama istiyorsunuz galiba.
Sayın Ziynettin'in affına sığınarak gerekli revizeyi yaptım.

C++:

Sub test()
son = Cells(Rows.Count, 2).End(3).Row
a = Range("B1:F" & son).Value
Set dc = CreateObject("scripting.dictionary")
ReDim b(1 To UBound(a), 1 To 5)
ReDim c(1 To UBound(a), 1 To 5)

For i = 2 To UBound(a)
    krt = a(i, 2)
    If Not dc.exists(krt) Then
  
        dc(krt) = dc.Count + 1
        Say = dc.Count
        b(Say, 1) = krt
      
        If a(i, 1) = "Alış" Then
            b(Say, 2) = a(i, 4)
            b(Say, 5) = CDbl(a(i, 5))
         End If
          
        If a(i, 1) = "Satış" Then
            b(Say, 3) = a(i, 4)
        End If
      
    Else
  
        Say = dc(krt)
        If a(i, 1) = "Alış" Then
            b(Say, 2) = b(Say, 2) + a(i, 4)
            b(Say, 5) = b(Say, 5) + CDbl(a(i, 5))
        End If
      
        If a(i, 1) = "Satış" Then
            b(Say, 5) = b(Say, 5) - (b(Say, 5) / b(Say, 4) * a(i, 4))      'Devir Tutarı - (Devir Tutarı / Devir Miktarı * Satış Miktarı)
            b(Say, 3) = b(Say, 3) + a(i, 4)
          
        End If
      
    End If
  
    b(Say, 4) = b(Say, 2) - b(Say, 3)
  
Next i

For i = 1 To dc.Count
    If b(i, 4) <> 0 Then
        n = n + 1
        c(n, 1) = b(i, 1)
        c(n, 2) = b(i, 2)
        c(n, 3) = b(i, 3)
        c(n, 4) = CDbl(b(i, 4))
        c(n, 5) = CDbl(b(i, 5)) / CDbl(b(i, 4))      'Devir Tutarı / Devir Miktarı
    End If
Next i

Range("O2:S" & Rows.Count).ClearContents
Range("O2:S" & Rows.Count).ClearFormats
[O2].Resize(n, 5).Borders.Color = rgbSilver
[S2].Resize(n).NumberFormat = "#,##0.00"
[O2].Resize(n, 5) = c

MsgBox "İşlem bitti...", vbInformation
End Sub

Sayın dost teşekkür ederim sorunun cevabı tam da bu makro, Sayın Ziynettin'in de emeği çok bu çalışmada.Galiba sorunu ben tam anlatamadım çözüme ulaşılma sürecinde. Tekrar her ikinize de çok teşekkür ederim , iyi çalışmalar...

dost · 4 Kasım 2021

Merhaba,

İlk önce işinizin çözüldüğüne sevindim.

Zaten ufak bir değişiklik dışında ben fazla bir şey yapmadım.

Aslında "Ağırlıklı ortalma" deyince Sayın Ziynettin'in yazdığı kod doğru.
Ancak "Hareketli ağırlıklı ortalma" deyince iş biraz değişiyor.

Mantığı kurup kodu yazan Sayın Ziynettin. Onun emeğine teşekkür ederiz.

Kolay gelsin.

Tablonun sadeleştirilmesi

sezgin06

Ekli dosyalar

Ziynettin

Destek Ekibi

Ekli dosyalar

sezgin06

sezgin06

sezgin06

Ekli dosyalar

sezgin06

Ziynettin

Destek Ekibi

sezgin06

Ekli dosyalar

dost

sezgin06

dost