muhasebe fişi oluşturmak

[NADİR YILDIZ]

Arkadaşlar merhaba ekte bir örnek excel dosyam var Sayfa1 e kadar istediğim verileri getirebiliyorum. Ancak ondan sonra en soldaki turuncu renkli olan bölüm kullandığım muhasebe programına dönebilmek için excel şablonu sağ taraftaki verileri sol tarafa aktarmam lazım ancak aktarırken fatura numarasına bakarak 2 satış şeklinde aktarmam lazım şöyle ki AB kolonundaki CARİ KODU ( hesap kodunun ) turuncu bölümde alacak kısmına aktarması ve yine AD KASA KODU kolonunu da kodlarıyla beraber borç kısmına yazması lazım bu şekilde bir işlem yapabilir miyim tşkler

 

[dost]

Arkadaşlar merhaba ekte bir örnek excel dosyam var Sayfa1 e kadar istediğim verileri getirebiliyorum. Ancak ondan sonra en soldaki turuncu renkli olan bölüm kullandığım muhasebe programına dönebilmek için excel şablonu sağ taraftaki verileri sol tarafa aktarmam lazım ancak aktarırken fatura numarasına bakarak 2 satış şeklinde aktarmam lazım şöyle ki AB kolonundaki CARİ KODU ( hesap kodunun ) turuncu bölümde alacak kısmına aktarması ve yine AD KASA KODU kolonunu da kodlarıyla beraber borç kısmına yazması lazım bu şekilde bir işlem yapabilir miyim tşkler

Merhaba,
Altın üyeliğim yok. Yüklemiş olduğunuz dosyayı haricen de yüklerseniz sorunuza bakabilirim.

 

[NADİR YILDIZ]

merhaba nasıl yükeleyeceğimi bilmiyorum altın üye almadan dosya yükleyemesiniz diyor

 

[NADİR YILDIZ]

arkadaşlar bu örneği çözebilecek arkadaş yok mu ?

 

[NADİR YILDIZ]

yardım edebilecek arkadaş var mı ?

 

[dost]

Merhaba,

Aşağıdaki kodu denersiniz.

Sub MuhasebeFisiYarat()

Dim lRow As Integer, iRow As Integer
Dim myData As Variant
Dim arrListB(), arrListA()

Sayfa1.Range("A2:J" & Sayfa1.Cells(Sayfa1.Rows.Count, "A").End(xlUp).Row + 1).ClearContents

lRow = Sayfa1.Cells(Sayfa1.Rows.Count, "O").End(xlUp).Row
iRow = 2

myData = Sayfa1.Range("O2:AE" & lRow).Value

For i = LBound(myData) To UBound(myData)
    arrListB = Array(myData(i, 16), myData(i, 17), myData(i, 2), "", "3 - Makbuz", myData(i, 6), "", myData(i, 7), "")
    arrListA = Array(myData(i, 14), myData(i, 5), myData(i, 2), "", "3 - Makbuz", myData(i, 6), "", "", myData(i, 7))
    Sayfa1.Cells(iRow, 1).Resize(, 9) = Application.Index(arrListB, 1, Application.Evaluate("column(1:9)"))
    Sayfa1.Cells(iRow + 1, 1).Resize(, 9) = Application.Index(arrListA, 1, Application.Evaluate("column(1:9)"))
    iRow = iRow + 2
Next i

MsgBox "Muhasebe kayıtları tamamlandı !"
          
End Sub