Ara toplamlardaki hesap kodları ayrı sayfalarda gösterilmesi

[1903emre34@gmail.com]

Merhaba,

"A" sütundaki, ara toplam 1 100 ve ara toplam 1 102 ilgili hesap kodların ayrı sayfalarda 100, 102 alt alta gösterilmesi,

Hesap kodların karşısında yer alan "E" ve "G" sütundaki tutarların toplamı alınıp(çizgiler) ve "H" ayrı sayfada gösterilmesi için nasıl kod oluşuturabiliriz? (Manuel olarak sayfa2 yapılmıştır)


http://s4.dosya.tc/server4/0tozsb/hesap_kodlari.zip.html

 

[askm]

Anladığım kadarıyla yaptım.

Sub ASKM_Hesapla()
Dim SonSatir As Long
SonSatir = Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To SonSatir
If Left(Cells(i, "A"), 10) = "Ara toplam" Then
    Cells(i, "G") = Cells(i, "G") + Cells(i, "E")
End If
Next
End Sub

 

[1903emre34@gmail.com]

Diğer sayfada gösterilmedi

 

[askm]

Diğer sayfada yapmadım kendi sayfa içerisinde.

 

[Erdem Akdemir]

Merhaba,

Tag'daki kodu deneyebilir misiniz.

Sub denememe()

Sayfa2.Select
Cells.Clear
Set con = VBA.CreateObject("adodb.Connection")

con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
ThisWorkbook.FullName & ";extended properties=""Excel 12.0;hdr=no"""

sorgu = "select  left(f2,3),sum(f5)+sum(f7),sum(f8),sum(f9) from[sayfa1$] group by left(f2,3) having sum(f2) is not null"
'sorgu = "select  f2 from[sayfa1$] where f2 is not null "

Set rs = con.Execute(sorgu)

Range("a1").CopyFromRecordset rs


End Sub

 

[1903emre34@gmail.com]

Hata verdi.

 

[Ziynettin]

Merhaba,

Alternatif olsun.

Option Explicit
Sub aktar()
Dim a(), b(), deg As Variant
Dim i As Long, Say As Long, S1 As Worksheet, S2 As Worksheet
Set S1 = Sheets("Sayfa1")
Set S2 = Sheets("Sayfa2")
a = S1.Range("A2:I" & S1.Cells(Rows.Count, 1).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To 4)
    For i = 1 To UBound(a)
        deg = "Ara toplam*"
        If a(i, 1) Like deg Then
            Say = Say + 1
            b(Say, 1) = Right(a(i, 1), 3)
            b(Say, 2) = a(i, 5) + a(i, 7)
            b(Say, 3) = a(i, 8)
            b(Say, 4) = a(i, 9)
        End If
    Next i
    Application.ScreenUpdating = False
    If Say > 0 Then
        S2.Select
        S2.Range("B2:E" & Rows.Count).ClearContents
        S2.[B2].Resize(Say, 4) = b
        S2.[C2].Resize(Say, 3).NumberFormat = "#,##0.00"
    End If
    Application.ScreenUpdating = True
MsgBox "İşlem tamam....", vbInformation
End Sub

 

[1903emre34@gmail.com]

Teşekkürler, Ziynettin bey

Kodlar tam istediğim gibi

İyi çalışmalar

 

[Erdem Akdemir]

Hata verdi.

Eklediginiz excel'de ben hata almadim.

 

[1903emre34@gmail.com]

Kodları çalıştırdığı zaman, sayfa1 verileri siliyor, daha sonra aşağıdaki uyarı veriyor

 

[Erdem Akdemir]

Eklediğiniz excel ile kullandığınız excel farklı olabilir.Hata veren dosyayı ekleyebilir misiniz.

 

[1903emre34@gmail.com]

Dosya ektedir, hata vermeyen dosyayı yüklermisin ?

 

[Erdem Akdemir]

Merhaba,

Aktar tuşuna bastığınızda kodun çalışması gerekli.
Bir ihtimal muhasebe programından çektiğiniz raporu 97-2003 excel formatında kullanıyorsanız ondan dolayı hata veriyor olabilir.