raporlama

[igultekin2000]

iyi akşamlar; demirbaş takibi için liste hazırlıyorum. devam etmek için raporlama kısmında takıldım. yardım istiyorum. Demirbaş listesine girilen verilerin bir kısımın Rapor çalışma sayfasına almak istiyorum. http://s9.dosya.tc/server2/ddrf2n/DEMIRBAS.rar.html

[/url][/IMG]

 

[Korhan Ayhan]

Aynı ürün için birden fazla satırda ALIŞ ya da SATIŞ olma durumu var mı?

Varsa bu durumda nasıl bir raporlama olacak?

 

[Asri]

Kontrol ediniz.

* aynı üründen birden fazla satış ve alış olmadığı varsayılmıştır.

http://dosya.co/m9s61oc41vj3/DEMIRBAS.xlsm.html

 

[igultekin2000]

açıklama

Aynı ürün için birden fazla satırda ALIŞ ya da SATIŞ olma durumu var mı?

Varsa bu durumda nasıl bir raporlama olacak?

yok her ürün için tek kod veriliyor, sadece giriş ve çıkış olarak bir defa yazılıyor

 

[igultekin2000]

teşekkürler sorunsuz çalışıyor,

 

[Ziynettin]

Makro ile,

Sub Rapor()
Dim a(), b(), d As Object
Dim s1 As Worksheet, s2 As Worksheet
Dim i As Long, Say As Long, son As Long
Set d = CreateObject("scripting.dictionary")
Set s1 = Sheets("DEMİRBAS_LISTESI")
Set s2 = Sheets("RAPOR")
son = s1.Range("A" & Rows.Count).End(3).Row
a = s1.Range("A2:J" & son).Value
ReDim b(1 To UBound(a), 1 To UBound(a, 2))
    For i = 1 To UBound(a)
        krt = a(i, 1)
        If a(i, 6) = "ALIŞ" Then
            If Not d.exists(krt) Then
                Say = Say + 1
                d.Add krt, Say
                b(Say, 1) = krt
                b(Say, 2) = a(i, 3)
                b(Say, 3) = a(i, 2)
                b(Say, 4) = a(i, 8)
                b(Say, 5) = a(i, 9)
                b(Say, 6) = a(i, 10)
            End If
        ElseIf a(i, 7) = "SATIŞ" Then
            b(Say, 7) = a(i, 2)
            b(Say, 8) = a(i, [SIZE="6"][SIZE="7"][COLOR="Red"]9[/COLOR][/SIZE][/SIZE])
        End If
    Next i
s2.Range("A4:H" & Rows.Count).ClearContents
If Say > 0 Then: s2.[A4].Resize(Say, 8) = b
MsgBox "İşlem tamam...", vbInformation
End Sub

 

[igultekin2000]

teşekkürler

Makro ile,

Sub Rapor()
Dim a(), b(), d As Object
Dim s1 As Worksheet, s2 As Worksheet
Dim i As Long, Say As Long, son As Long
Set d = CreateObject("scripting.dictionary")
Set s1 = Sheets("DEMİRBAS_LISTESI")
Set s2 = Sheets("RAPOR")
son = s1.Range("A" & Rows.Count).End(3).Row
a = s1.Range("A2:J" & son).Value
ReDim b(1 To UBound(a), 1 To UBound(a, 2))
    For i = 1 To UBound(a)
        krt = a(i, 1)
        If a(i, 6) = "ALIŞ" Then
            If Not d.exists(krt) Then
                Say = Say + 1
                d.Add krt, Say
                b(Say, 1) = krt
                b(Say, 2) = a(i, 3)
                b(Say, 3) = a(i, 2)
                b(Say, 4) = a(i, 8)
                b(Say, 5) = a(i, 9)
                b(Say, 6) = a(i, 10)
            End If
        ElseIf a(i, 7) = "SATIŞ" Then
            b(Say, 7) = a(i, 2)
            b(Say, 8) = a(i, 10)
        End If
    Next i
s2.Range("A4:H" & Rows.Count).ClearContents
If Say > 0 Then: s2.[A4].Resize(Say, 8) = b
MsgBox "İşlem tamam...", vbInformation
End Sub

başka kullanacak olur diye yazıyorum, alttakı Satış yazan yerdeki a(i,9) olacak. Teşekkürler sorunsuz çalışıyor. Makro daha pratik olmuş.

 

[Ziynettin]

Bazen gözden kaçabiliyor. Kod da gerekli düzenleme yapıldı.