Raporlama

[igultekin2000]

iyi akşamlar; cari hareket sayfasınaki verileri Bakiye sayfasnıda TL-USD-EURO olarak raporluyorum, alternatif olarak bir cariye ait döviz çeşitlerini yan yana yerine alt alta yapdırmak istiyorum. örnek belge ve resim ekledim. teşekkürler raporlama, isimleri yenilenen değer olara kopyalayıp ilk satıra oluşturduğun çoketopla formülünü aşağı doğru kopyalamak şeklinde.

 

[veyselemre]

Sub bakiyeBul()
    Set s1 = Sheets("cari_hareket")
    Set s2 = Sheets("Bakiye")
    son = s1.Cells(Rows.Count, 2).End(3).Row
    veri = s1.Range("D2:H" & son).Value
    ReDim liste(1 To son, 1 To 5)
  
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(veri)
            ky = veri(i, 1) & "|" & veri(i, 3)
                If Not .exists(ky) Then
                    say = say + 1
                    .Item(ky) = say
                    liste(say, 1) = veri(i, 1)
                    liste(say, 2) = 0
                    liste(say, 3) = 0
                    liste(say, 4) = 0
                    liste(say, 5) = veri(i, 3)
                End If
                sira = .Item(ky)
                
                liste(sira, 2) = CDbl(liste(sira, 2)) + CDbl(veri(i, 4))
                liste(sira, 3) = CDbl(liste(sira, 3)) + CDbl(veri(i, 5))
                liste(sira, 4) = CDbl(liste(sira, 2)) - CDbl(liste(sira, 3))
        
        Next i
    End With
    s2.Range("a4:e" & Rows.Count).ClearContents
    If say > 0 Then
        s2.Range("A4").Resize(say, 5).Value = liste
        s2.Range("a4:e" & s2.Cells(Rows.Count, 1).End(3).Row).Sort s2.Range("A4")
    Else
        MsgBox "Uygun kayıt bulunamadı..."
    End If
End Sub

 

[igultekin2000]

Sub bakiyeBul()
    Set s1 = Sheets("cari_hareket")
    Set s2 = Sheets("Bakiye")
    son = s1.Cells(Rows.Count, 2).End(3).Row
    veri = s1.Range("D2:H" & son).Value
    ReDim liste(1 To son, 1 To 5)
 
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(veri)
            ky = veri(i, 1) & "|" & veri(i, 3)
                If Not .exists(ky) Then
                    say = say + 1
                    .Item(ky) = say
                    liste(say, 1) = veri(i, 1)
                    liste(say, 2) = 0
                    liste(say, 3) = 0
                    liste(say, 4) = 0
                    liste(say, 5) = veri(i, 3)
                End If
                sira = .Item(ky)
              
                liste(sira, 2) = CDbl(liste(sira, 2)) + CDbl(veri(i, 4))
                liste(sira, 3) = CDbl(liste(sira, 3)) + CDbl(veri(i, 5))
                liste(sira, 4) = CDbl(liste(sira, 2)) - CDbl(liste(sira, 3))
       
        Next i
    End With
    s2.Range("a4:e" & Rows.Count).ClearContents
    If say > 0 Then
        s2.Range("A4").Resize(say, 5).Value = liste
        s2.Range("a4:e" & s2.Cells(Rows.Count, 1).End(3).Row).Sort s2.Range("A4")
    Else
        MsgBox "Uygun kayıt bulunamadı..."
    End If
End Sub

Elinize sağlık, çok güzel olmuş. Teşekkür ederim. Hayırlı geceler.