Soru Vba ile Kalan gösterme

[TUGBADM]

Merhaba,

Ekte yer alan dosyamda Giriş-Çıkış-Kalan kısımları vardır. Stok kısmında Giriş kısmında Firma Adı ve Proje Adı aynı olanların miktarları toplanmakta ve Giriş Miktarı kısmında yazmaktadır. Aynı firma farklı proje adı varsa onun miktarını ayrıca toplamaktadır. Yine Stok kısmında Çıkış Miktarları bölümüne Firma Adı ve Proje Adı aynı olanların Toplam Çıkış miktarlarını göstermesini istiyorum. Aynı firma faklı Proje Adı varsa onun çıkışlarını da ayrıca yapmalı giriş mantığındaki gibi. Fakat aynı satırda yazdırama kısmını yamamadım. Benim yaptığıma göre çıkışı kalan satırın altından devam ettiriyor. Bu kısım için yardımcı olabilir misiniz?

 

[yanginci34]

Merhaba; umarım doğru anlamışımdır. Dener misiniz?

 

[TUGBADM]

Merhaba; umarım doğru anlamışımdır. Dener misiniz?

Stok kısmındaki Sarı Lacivert giriş çıkış kalan doğru, diğerleri yanlış. Bir de VBA kodlarını nereye yazdığınızı bulamadım

 

[yanginci34]

Şuan PC nin yanında değilim üzgünüm yarın bakarım.Ben extra VBA code yazmadım sizin mevcut code ile oynama yaptım

 

[Necdet]

Merhaba,

Elektrik kesintisi olunca baya geciktir benim yanıtım.

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.
Gerekirse bu kodları sizin yazdığınız bölüme aktarabilirsiniz.

Sonucu bildirirseniz sevinirim.

Sub Makro1()
'                               Referanslardan Microsoft Sicripting Runtime Seçilmelidir
    Dim sh  As Worksheet
    Dim deg As Variant
    Dim i   As Long
    Dim key As Variant
    Dim item As Variant
    Dim dic As Dictionary
    Dim arr As Variant
    Dim ar  As Variant
    
    Set dic = New Dictionary
    dic.CompareMode = TextCompare

    For Each sh In Sheets(Array("Giris", "Cikis"))
    
        arr = sh.Range("A1").CurrentRegion.Value
        
        For i = 2 To UBound(arr)
        
            deg = arr(i, 5) & "|" & arr(i, 6)
            If Not dic.Exists(deg) Then
                If sh.Name = "Giris" Then
                    dic.Add deg, arr(i, 7) & "|" & 0
                Else
                    dic.Add deg, 0 & "|" & arr(i, 7)
                End If
            Else
                ar = Split(dic.item(deg), "|")
                If sh.Name = "Giris" Then
                    ar(0) = ar(0) + arr(i, 7)
                Else
                    ar(1) = ar(1) + arr(i, 7)
                End If
                dic.item(deg) = Join(ar, "|")
            End If
            
        Next i
        Set arr = Nothing
        
    Next sh
    
    key = dic.Keys
    item = dic.Items
    
    Sheets("Stok").Range("A1").CurrentRegion.Offset(1).ClearContents
    Sheets("Stok").Range("A2") = 1
    
    For i = 0 To UBound(key)
    
        Sheets("Stok").Cells(i + 2, "B") = Split(key(i), "|")(0)
        Sheets("Stok").Cells(i + 2, "C") = Split(key(i), "|")(1)
        
        Sheets("Stok").Cells(i + 2, "D") = Split(item(i), "|")(0)
        Sheets("Stok").Cells(i + 2, "E") = Split(item(i), "|")(1)
        
        Sheets("Stok").Cells(i + 2, "F") = Sheets("Stok").Cells(i + 2, "D") - Sheets("Stok").Cells(i + 2, "E")
        
    Next i
    
    Sheets("Stok").Range("A2:A" & i + 1).DataSeries
    
End Sub

 

[TUGBADM]

Şuan PC nin yanında değilim üzgünüm yarın bakarım.Ben extra VBA code yazmadım sizin mevcut code ile oynama yaptım

Kodlarınız çalışıyor teşekkürler.

 

[TUGBADM]

Merhaba,

Elektrik kesintisi olunca baya geciktir benim yanıtım.

Aşağıdaki kodları bir modüle kopyalayıp deneyiniz.
Gerekirse bu kodları sizin yazdığınız bölüme aktarabilirsiniz.

Sonucu bildirirseniz sevinirim.

Sub Makro1()
'                               Referanslardan Microsoft Sicripting Runtime Seçilmelidir
    Dim sh  As Worksheet
    Dim deg As Variant
    Dim i   As Long
    Dim key As Variant
    Dim item As Variant
    Dim dic As Dictionary
    Dim arr As Variant
    Dim ar  As Variant
   
    Set dic = New Dictionary
    dic.CompareMode = TextCompare

    For Each sh In Sheets(Array("Giris", "Cikis"))
   
        arr = sh.Range("A1").CurrentRegion.Value
       
        For i = 2 To UBound(arr)
       
            deg = arr(i, 5) & "|" & arr(i, 6)
            If Not dic.Exists(deg) Then
                If sh.Name = "Giris" Then
                    dic.Add deg, arr(i, 7) & "|" & 0
                Else
                    dic.Add deg, 0 & "|" & arr(i, 7)
                End If
            Else
                ar = Split(dic.item(deg), "|")
                If sh.Name = "Giris" Then
                    ar(0) = ar(0) + arr(i, 7)
                Else
                    ar(1) = ar(1) + arr(i, 7)
                End If
                dic.item(deg) = Join(ar, "|")
            End If
           
        Next i
        Set arr = Nothing
       
    Next sh
   
    key = dic.Keys
    item = dic.Items
   
    Sheets("Stok").Range("A1").CurrentRegion.Offset(1).ClearContents
    Sheets("Stok").Range("A2") = 1
   
    For i = 0 To UBound(key)
   
        Sheets("Stok").Cells(i + 2, "B") = Split(key(i), "|")(0)
        Sheets("Stok").Cells(i + 2, "C") = Split(key(i), "|")(1)
       
        Sheets("Stok").Cells(i + 2, "D") = Split(item(i), "|")(0)
        Sheets("Stok").Cells(i + 2, "E") = Split(item(i), "|")(1)
       
        Sheets("Stok").Cells(i + 2, "F") = Sheets("Stok").Cells(i + 2, "D") - Sheets("Stok").Cells(i + 2, "E")
       
    Next i
   
    Sheets("Stok").Range("A2:A" & i + 1).DataSeries
   
End Sub

Sizin kodlarınızı da kendi dosyama uyarladım. Bu kodlarla da başarılı bir şekilde çalışıyor. Teşekkür ederim.

 

[Necdet]

Güle güle kullanınız.