Fiş No'ya Göre Veri Getirme

[randzafer]

Merhaba arkadaşlar, üstadlara selamlar,
Elimde 150 bin satırlık bir veri tablosu var, fiş numarasına göre muavin hareketler. Amacım gider hesaplarının (740-770-780) karşılıklarına gelen ödemeleri bulmak, Örneğin 770-...001 Kırtasiye gideri 100 TL ise karşı bacağı olan 320.00012 Bilgin Kırtasiye 50 TL + 320.00013 Akçay Kırtasiye 50 TL gibi. Örnek dosyayı ekledim. Dosyanın içinde örnek sayfa da mevcut. Bu fişlerin karşılıklarının Rapor sayfasına gelmesini istiyorum, Rapor sayfasına gider hesaplarındaki (Veri sayfasındaki 740-770-780 hesapların fiş noları) benzersiz fiş numaralarını da yazdım ama bu fiş numaralarını da formül ile oraya getirtebilirsek çok güzel olur. Yardımlarınızı rica ediyorum, şimdiden teşekkürler.

 

[ZorBey_]

Denermisiniz.

 

[randzafer]

Üstad emeğine sağlık, teşekkürler, ama her defasında tek bir fiş seçmeyeceğim yani mesela 770 Hesap grubundaki bütün fiş numaralarını bir sayfaya alacağım ve karşı bacaklarının gelmesini isteyeceğim böyle bir şey mümkün müdür acaba? Bir de bunu formülle yapmak çok mu kasar excell'i çünkü 150 bin satır falan var.

 

[ZorBey_]

Sayın randzafer arka arkaya farklı fişlermi seçmek istiyorsunuz.

 

[randzafer]

Üstad arka arkaya seçmek çok zamanımı alır yani tek tek seçemem ,mesela 770 Hesap grubundaki Kırtasiye giderleri 3.500 TL bu gidere ait 20 tane fiş var bu fişlerin benzersiz olanlarını sayfa X'te A Sütununa yapıştıracağım ve karşı bacaklarının gelmesini isteyeceğim. Başlangıçta biraz yanlış anlattım galiba.

 

[ZorBey_]

O halde konunun fiş numarası ile ilgisi yok.
Hesap kodunun ilk 3 rakamına göre veri çağıramak istiyorsunuz.

 

[veyselemre]

Örneği inceleyin,

Sub aktarDictionary()
    Sheets("Rapor").Range("b2:e65536").ClearContents

    Set shV = Sheets("Veri")
    sonVeriSat = shV.[a65536].End(3).Row
    shVeri = shV.Range("A2", "F" & sonVeriSat).Value2

    With CreateObject("scripting.dictionary")
        For i = LBound(shVeri) To UBound(shVeri)
            Select Case shVeri(i, 2)
            Case 740, 770, 780
                a = .Item(shVeri(i, 3))
            End Select
        Next i

        ReDim filtreveri(LBound(shVeri) To UBound(shVeri))
        For i = LBound(shVeri) To UBound(shVeri)
            If .Exists(shVeri(i, 3)) Then
                say = say + 1
                filtreveri(say) = Application.Index(shVeri, i, Array(3, 4, 5, 6))
            End If
        Next i
    End With

    ReDim Preserve filtreveri(LBound(shVeri) To say)

    filtreveri = Application.Transpose(Application.Transpose(filtreveri))
    Sheets("Rapor").[b2].Resize(UBound(filtreveri), 4) = filtreveri
    Sheets("Rapor").[b2].Resize(UBound(filtreveri), 1).NumberFormat = "000000000000000"
    Sheets("Rapor").[e2].Resize(UBound(filtreveri), 1).NumberFormat = "#,##0.00"

End Sub

Sub aktarAdo()
    Sheets("Rapor").Range("b2:e65536").ClearContents

    Set con = CreateObject("adodb.connection")
    con.Open "provider=microsoft.jet.oledb.4.0;data source=" & _
             ThisWorkbook.FullName & ";extended properties=""excel 8.0;hdr=yes"""

    Set rs = con.Execute("select FISNO, HES_KOD, ACIKLAMA, Toplam from [veri$] where FISNO in (SELECT DISTINCT FISNO FROM [veri$] WHERE KEBİR in ('740','770','780'))")

    Sheets("Rapor").[b2].CopyFromRecordset rs
    Sheets("Rapor").Range("b2", Sheets("Rapor").[b65536].End(3)).NumberFormat = "000000000000000"
    Sheets("Rapor").Range("e2", Sheets("Rapor").[e65536].End(3)).NumberFormat = "#,##0.00"

    rs.Close: Set rs = Nothing
    con.Close: Set con = Nothing
End Sub

 

[randzafer]

Evet aslında öyle, yani ben gider hesaplarındaki tutarların karşı bacaklarını getireceğim yani bu bir gider analiz raporu, Ödeme bazlı giderleri getirmek istiyorum, mesela taksi giderlerinin açıklamalarından kim olduklarını ya da bilgi işlem giderlerinin hangi firmalardan hizmet aldığımızı çıkartmak istiyorum ya da telefon giderlerimizin hangi gsm operatörlerinden olduğunu getirmek istiyorum. Başlangıçtaki ifade hatam için kusuruma bakmayın, gecenin bu saatinde emek veriyorsunuz bunun için de ayrıca teşekkürler. Allah Razı olsun.