Banka Ekstresi

[Musa Batur]

Arkadaşlar ekde gönderdiğim dosyada bankadan aldığım ektrayı orka muhasebeye aktarmak için makra yapılması gerekli ben bilmediğim için sizlerden yardım istiyorum.

Simdiden Teşekkür edrim
Musa Batur

 

[tahsinanarat]

Data dosyasına aktarılmasını istediğinizi sonradan fark ettim.

 

[Musa Batur]

Data sayfasındaki verileri rapor sayfasındaki gibi yapabilirmişiniz

Teşekkürler

 

[Recep İpek]

Aşağıdaki kodları deneyiniz.

Sub Raporla()
Dim a, i, n, b()
Dim st As String
Set s1 = Sheets("DATA")
Set s2 = Sheets("Rapor")
'*******************************************
a = s1.Range("a2:d" & s1.[a65536].End(3).Row).Value
ReDim veri(1 To UBound(a, 1) * 4, 1 To 9)
madno = 1
    For i = 1 To UBound(a, 1)
        If i > 1 Then
            If a(i, 1) <> a(i - 1, 1) Then madno = madno + 1
        End If
            For j = 1 To 2
            s = s + 1
                veri(s, 1) = Format(a(i, 1), "dd.mm.yyyy")  ' A Kolonu
                veri(s, 2) = "MAHSUP"                       ' B Kolonu
                veri(s, 3) = madno                          ' C Kolonu
                If j = 1 Then veri(s, 4) = a(i, 2)          ' D Kolonu
                st = a(i, 3)
                veri(s, 6) = fnGetCharacters(st, True)      ' F Kolonu
                veri(s, 7) = a(i, 3)                        ' G Kolonu
                If j = 1 Then
                    If a(i, 4) > 0 Then
                        veri(s, 8) = a(i, 4)                'H Kolonu
                    Else
                        veri(s, 9) = Abs(a(i, 4))           'I Kolomu
                    End If
                Else
                    If a(i, 4) < 0 Then
                        veri(s, 8) = Abs(a(i, 4))
                    Else
                        veri(s, 9) = a(i, 4)
                    End If
                End If
        Next j
    Next i
'*******************************************
If s > 0 Then
sonsat = s2.[a65536].End(3).Row + 1
s2.Range(s2.Cells(2, "a"), s2.Cells(sonsat, "I")).ClearContents
s2.[a2].Resize(s, 9).Value = veri
Else
MsgBox "Kayıt Bulunamadı.", vbInformation, "Bilgi"
End If
'*******************************************
s2.Select
MsgBox "Bitti"
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[tahsinanarat]

Eline koluna sağlık Recep bey döktürmüşsünüz yine, Hayırlı Ramazanlar

 

[Musa Batur]

RECEP BEY

Sizlere nasil teşekkür etsem azdır. Allah tututgunuzu altın etsin

Saygılarımla

Musa BATUR

 

[exes]

Sayın Recep bey,
Benzer bir problemim var.
Dosyada ne istediğimi anlatmaya çalıştım. Yardımcı olacak arkadaşlara teşekkür ederim.

 

[exes]

Baya bir uğraşıdan sonra problemimi çözdüm. İlgilenen arkadaşlara kodu sunuyorum.

Sub Raporla()
Dim a, i, n, b()
Dim c As Integer
Set s1 = Sheets("data")
Set s2 = Sheets("rapor")
'*******************************************
a = s1.Range("a9:F" & s1.[a65536].End(3).Row)
c = s1.[a65536].End(3).Row
ReDim veri(1 To UBound(a, 1) * c, 1 To 9)
 
            For j = 1 To c - 6
            s = s + 1
                veri(s, 1) = s1.Range("B1"): veri(s, 2) = s1.Range("d4"): veri(s, 3) = s1.Range("b2")
                veri(s, 4) = s1.Range("A3"): veri(s, 5) = s1.Range("B3")
                veri(s, 6) = s1.Cells(j + 8, 1)
                veri(s, 7) = s1.Range("E4") & "-" & Mid(s1.Range("B3"), 1, 20) & "-" & s1.Range("B2")
                If j = 1 Then
                If s1.Range("b2") = "SATIŞ" Then
                veri(s, 8) = s1.Range("H4")
                Else
                veri(s, 9) = s1.Range("H4")
                End If
                End If
                If j = 2 Then
                veri(s, 4) = s1.Range("G3"): veri(s, 5) = s1.Range("G4")
                veri(s, 6) = s1.Range("A3")
                If s1.Range("b2") = "SATIŞ" Then
                veri(s, 9) = s1.Range("H3")
                Else
                veri(s, 8) = s1.Range("H3")
                End If
                End If
                If j > 2 Then
                veri(s, 4) = s1.Cells(j + 6, 1): veri(s, 5) = s1.Cells(j + 6, 2)
                veri(s, 6) = s1.Range("A3")
                If s1.Range("b2") = "SATIŞ" Then
                veri(s, 9) = s1.Cells(j + 6, 6)
                Else
                veri(s, 8) = s1.Cells(j + 6, 6)
                End If
                End If
         Next j
'*******************************************
sonsat = s2.[a65536].End(3).Row + 1
s2.Range("a" & sonsat).Resize(s, 9).Value = veri
'*******************************************
s2.Select
MsgBox "Bitti"
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[levyekan]

Merhaba
Banka ekstrelerinin xls formatında olanına ihtiyacım var. elinde exel formatında ektre bulunan paylaşırsa sevinirim.