Excelden Muhasebe Programına Veri Aktarımı (1 satırı 3 kopya ile çoğaltma)

ovarnali1 · 27 Ocak 2014

Herkese Merhaba,

Muhasebe programına veri aktarımı yapılacak bir excel dosyası oluşturmam gerek. Ekteki dosyada "2014 fatura detayı" sayfasından verileri alarak "2014 muhasebe dosyası" na aktarım yapmasını istiyorum. "2014Fatura detayı" sayfasındaki her satır için "2014 muhasebe dosyası" sayfasında 3 satır açmam gerek.

Formülüzasyonu oluşturdum ama takıldığım nokta 2014 muhasebe dosyasında kopyalama yaparken muhasebe sayfasına 3 satır atlayarak veri aktarımı yapılması buda aradaki faturaların işlenememesine neden oluyor. Umarım sorunu anlatabilmişimdir.

Teşekkürler

Emir Hüseyin Çoban · 27 Ocak 2014

. . .

Dosyanız ektedir.

...::: Ekli Dosyayı İndirmek İçin Linki Tıklayınız :::...
http://yadi.sk/d/LNYgLLD_GouSk

Kod:

Sub KOD()
    Application.ScreenUpdating = False

    Dim S1     As Worksheet
    Dim S2     As Worksheet
    Dim i      As Long
    Dim sat    As Long

    Set S1 = Sheets("2014 FATURA DETAYI")
    Set S2 = Sheets("2014 MUHASEBE DOSYASI")

    S2.Range("B4:J65536").ClearContents
    For i = 5 To S1.[B65536].End(3).Row
        sat = [B65536].End(3).Row + 1

        S2.Cells(sat, "B") = S1.Cells(i, "A")
        S2.Cells(sat + 1, "B") = S1.Cells(i, "A")
        S2.Cells(sat + 2, "B") = S1.Cells(i, "A")

        S2.Cells(sat, "C") = S1.Cells(i, "B")
        S2.Cells(sat + 1, "C") = S1.Cells(i, "B")
        S2.Cells(sat + 2, "C") = S1.Cells(i, "B")

        S2.Cells(sat, "E") = S1.Cells(i, "D") & " Ft. " & S1.Cells(i, "A")
        S2.Cells(sat + 1, "E") = S1.Cells(i, "D") & " Ft. " & S1.Cells(i, "A")
        S2.Cells(sat + 2, "E") = S1.Cells(i, "D") & " Ft. " & S1.Cells(i, "A")

        S2.Cells(sat, "F") = S1.Cells(i, "E")
        S2.Cells(sat + 1, "F") = S1.Cells(i, "E")
        S2.Cells(sat + 2, "F") = S1.Cells(i, "E")

        S2.Cells(sat, "G") = S1.Cells(i, "F")
        S2.Cells(sat + 1, "G") = S1.Cells(i, "F")
        S2.Cells(sat + 2, "G") = S1.Cells(i, "F")

        S2.Cells(sat, "H") = S1.Cells(i, "U")
        S2.Cells(sat + 1, "I") = S1.Cells(i, "V")
        S2.Cells(sat + 2, "J") = S1.Cells(i, "W")

    Next

    Application.ScreenUpdating = True
    MsgBox " B i t t i"
End Sub

. . .

ovarnali1 · 28 Ocak 2014

Hüsayin Bey

Yardımlarınız için çok teşekkür ederim. Örnek yazmış olduğunuz kodu gerçek dosyaya yerleştirirken aşağıdaki şekilde düzenlemeye gittim. Bir konuda daha yardımınıza ihtiyacım olacak.

Malum bazı faturalar iptal olabiliyor bu kod içine veri dosyasındaki A sütunundaki fatura numarası bold+kırmızı renkli ise direk bir sonraki faturaya oda bold+kırmızı renkli ise bir sonrakine ... taki normal yazılı olana kadar git diyebilirmiyiz? Ayrıca Matrah kdv veya toplam hücrelerindeki rakamlar ekranda virgülden sonra 2 hane rakamı göstermesine karşın hücre içindeki veri virgülden sonra bazen 5-6 rakama kadar çıkabilmektedir. Bunu yuvarla ve sadece virgül sonrasında 2 rakam yaz diyebilirmiyiz?

Sub KOD()
Application.ScreenUpdating = False

Dim S1 As Worksheet
Dim S2 As Worksheet
Dim i As Long
Dim sat As Long

Set S1 = Sheets("2014 FATURA DETAYI")
Set S2 = Sheets("2014 MUHASEBE DOSYASI")

S2.Range("A4:I65536").ClearContents
For i = 5 To S1.[A65536].End(3).Row
sat = [A65536].End(3).Row + 1

S2.Cells(sat, "A") = S1.Cells(i, "A")
S2.Cells(sat + 1, "A") = S1.Cells(i, "A")
S2.Cells(sat + 2, "A") = S1.Cells(i, "A")

S2.Cells(sat, "B") = S1.Cells(i, "B")
S2.Cells(sat + 1, "B") = S1.Cells(i, "B")
S2.Cells(sat + 2, "B") = S1.Cells(i, "B")

S2.Cells(sat, "D") = S1.Cells(i, "D") & " Ft. " & S1.Cells(i, "A")
S2.Cells(sat + 1, "D") = S1.Cells(i, "D") & " Ft. " & S1.Cells(i, "A")
S2.Cells(sat + 2, "D") = S1.Cells(i, "D") & " Ft. " & S1.Cells(i, "A")

S2.Cells(sat, "E") = S1.Cells(i, "E")
S2.Cells(sat + 1, "E") = S1.Cells(i, "E")
S2.Cells(sat + 2, "E") = S1.Cells(i, "E")

S2.Cells(sat, "F") = S1.Cells(i, "F")
S2.Cells(sat + 1, "F") = S1.Cells(i, "F")
S2.Cells(sat + 2, "F") = S1.Cells(i, "F")

S2.Cells(sat, "H") = S1.Cells(i, "Y")
S2.Cells(sat + 1, "I") = S1.Cells(i, "Z")
S2.Cells(sat + 2, "J") = S1.Cells(i, "AA")

Next

Application.ScreenUpdating = True
MsgBox " T a m a m l a n d ı"
End Sub

Peşinen teşekkür ederim.

Emir Hüseyin Çoban · 28 Ocak 2014

. . .

Tablonun son haline göre ve yukarıdaki sorularınızın yer aldığı örnek bir dosya ekleyiniz.

. . .

ovarnali1 · 28 Ocak 2014

Dosya ektedir Hüseyin Bey

Emir Hüseyin Çoban · 28 Ocak 2014

. . .

İptallerde bold+kırmızı yerine, iptal yazıyor mu diye koşul eklesek daha doğru olmaz mı ?

. . .

ovarnali1 · 28 Ocak 2014

dediğiniz gibi o halde "B" sütununda iptal yazıyor ise direk bir sonrakine git demek daha basit olur bencede.

Emir Hüseyin Çoban · 28 Ocak 2014

. . .

Şu kodları deneyiniz.
Kırmızı ile belirttiğim kısımlar hatalı yaptığınız düzeltmeler.
Mavi ile belirttiğim kısımlar, ilaveler.

Kod:

Sub KOD()
    Application.ScreenUpdating = False

    Dim S1     As Worksheet
    Dim S2     As Worksheet
    Dim i      As Long
    Dim sat    As Long

    Set S1 = Sheets("2014 FATURA DETAYI")
    Set S2 = Sheets("2014 MUHASEBE DOSYASI")

    S2.Range("A4:I65536").ClearContents
    For i = 5 To S1.[A65536].End(3).Row
        [COLOR=Blue]If S1.Cells(i, "B") = "İPTAL" Then
        Else[/COLOR]
            [COLOR=Red]sat = [B]S2.[/B][A65536].End(3).Row + 1[/COLOR]

            S2.Cells(sat, "A") = S1.Cells(i, "A")
            S2.Cells(sat + 1, "A") = S1.Cells(i, "A")
            S2.Cells(sat + 2, "A") = S1.Cells(i, "A")

            S2.Cells(sat, "B") = S1.Cells(i, "B")
            S2.Cells(sat + 1, "B") = S1.Cells(i, "B")
            S2.Cells(sat + 2, "B") = S1.Cells(i, "B")

            S2.Cells(sat, "D") = S1.Cells(i, "D") & " Ft. " & S1.Cells(i, "A")
            S2.Cells(sat + 1, "D") = S1.Cells(i, "D") & " Ft. " & S1.Cells(i, "A")
            S2.Cells(sat + 2, "D") = S1.Cells(i, "D") & " Ft. " & S1.Cells(i, "A")

            S2.Cells(sat, "E") = S1.Cells(i, "E")
            S2.Cells(sat + 1, "E") = S1.Cells(i, "E")
            S2.Cells(sat + 2, "E") = S1.Cells(i, "E")

            S2.Cells(sat, "F") = S1.Cells(i, "F")
            S2.Cells(sat + 1, "F") = S1.Cells(i, "F")
            S2.Cells(sat + 2, "F") = S1.Cells(i, "F")

            [COLOR=Red]S2.Cells(sat, [B]"G"[/B])[/COLOR] = [COLOR=Blue]WorksheetFunction.Round(S1.Cells(i, "Y"), 2)[/COLOR]
            [COLOR=Red]S2.Cells(sat + 1,[B] "H"[/B]) [/COLOR]= [COLOR=Blue]WorksheetFunction.Round(S1.Cells(i, "Z"), 2)[/COLOR]
           [COLOR=Red] S2.Cells(sat + 2, [B]"I"[/B]) [/COLOR]= [COLOR=Blue]WorksheetFunction.Round(S1.Cells(i, "AA"), 2)[/COLOR]
       [COLOR=Blue] End If[/COLOR]
    Next

    Application.ScreenUpdating = True
    MsgBox " T a m a m l a n d ı"
End Sub

. . .

ovarnali1 · 28 Ocak 2014

Aktarım yapıyor herhangi bir sorun yok ama "Tamamlandı" değilde "type mistmatch" hatası veriyor.
Bunun dışında herşey için çok teşekkür ederim.

Emir Hüseyin Çoban · 28 Ocak 2014

ovarnali' Alıntı:
Aktarım yapıyor herhangi bir sorun yok ama "Tamamlandı" değilde "type mistmatch" hatası veriyor.
Bunun dışında herşey için çok teşekkür ederim.

. . .

Bende böyle bir hata uyarısı vermiyor.
Hata aldığınız dosyayı eklerseniz, kontrol edebiliriz.

. . .

ovarnali1 · 28 Ocak 2014

deneme yanılma yöntemi ile çözdüm çok teşekkürler

bendeki veri sayfasında fatura numaraları aşağıya kadar devam ettiğinden sanırm öyle bir hata veriyordu satırların hepsini silip tekrar eklediğimde hata düzeldi.

hesap kodu kısmına muhasebede belirtilen kodun aynısının atanmasını ne şekilde yapabiliriz? yaklaşık 100 hesap var. mantık firma adı a ise sadece toplam satırına (matrah ve kdv aynı olduğu için kopya ile çözebiliyorum) örneğin 120.02.001 ata gibi.

yardımlarınız için tekrar teşekkür ederim.

ovarnali1 · 30 Ocak 2014

Hüseyin Bey,

Sorduğum soru üzerinde biraz çalışarak ekteki kodlu test dosyasını oluşturdum.
Sizden ricam bu kod dosyasına örnek bir çalışma ilave etmeniz. Test dosyası sayfa 1 de "d" sütununda Ünvan A ise sayfa 2 de 3.satıra 120.00.001 in atanması gibi.

Peşinen teşekkürler

Emir Hüseyin Çoban · 30 Ocak 2014

. . .

Ünvan A standart veri mi ? Bu kısmı biraz daha açmalısınız.
Muhasebe dosyası sayfasının, kodlar çalıştıktan sonra nasıl olması gerektiğini gösteren bir örnek ekleyin.

. . .

ovarnali1 · 30 Ocak 2014

Üstadım firma adı ve kod sürekli değişiklik gösteriyor olacak ama her firmanın tek kodu olacak.

Örnek 1.sayfada firma adı "ali a.ş." ise 2.sayfada kopyalanan 3.satırın hesab kodu sütununa "120.01.003" yaz gibi.

Ekteki örnek dosyada daha açıklayıcı görebilirsiniz.

Emir Hüseyin Çoban · 30 Ocak 2014

. . .

Firma isimlerine göre 120 li kodları başka bir yerden çekmemiz gerekmiyor mu ?
Yoksa sıradan 120 kodlarına 120.01.001 - 120.01.002 diye yeni kodmu vereceğiz ?

. . .

ovarnali1 · 30 Ocak 2014

Daha kolayı hangisi olur?

mesela 3. bi sayfa daha yaratıp oraya hangi firmanın kodu ne onu listeleyebiliriz.

ali a.ş. 120.01.003
ahmet ltd şti 120.01.005 gibi

bu kodlar muhasebe tarafından daha önceden verilmiş kodlar olduğundan bizim yapmakta olduğumuz excel dosyasında onların verdiği numaralar olarak yer alması gerekmektedir. yani sıradan hepsine excelin kod vermesi doğru olmayacaktır.

Emir Hüseyin Çoban · 30 Ocak 2014

. . .

O zaman hesap kodlarının yer aldığı bir sayfa daha olmalı.
Firma isimlerine göre veya vergi noya göre teyit etmek daha doğru olacaktır.
Bu şekilde bir örnek eklemelisiniz.

. . .

ovarnali1 · 30 Ocak 2014

3.Sayfada istenilen bilgilerin yer aldığı bir tablo görülebilir.

Emir Hüseyin Çoban · 30 Ocak 2014

. . .

Şu kodları deneyiniz.
Not: Daha önce hata aldığınızdan bahsetmiştiniz.
Sebebi örneğin I-086329 ve I-086330 nolu faturalar için matrah kısımları boş.
Boş hücreleri sayısal veri olarak yuvarlamaya çalışıyor. Bu yüzden hata veriyor.
O kısmada bir koşul ekledim.

Kod:

Sub KOD()
    Application.ScreenUpdating = False

    Dim S1     As Worksheet
    Dim S2     As Worksheet
    Dim S3     As Worksheet
    Dim i      As Long
    Dim sat    As Long
    Dim ara

    Set S1 = Sheets("2014 FATURA DETAYI")
    Set S2 = Sheets("2014 MUHASEBE DOSYASI")
    Set S3 = Sheets("MUH KODLARI")

    S2.Range("A4:I65536").ClearContents
    For i = 5 To S1.[A65536].End(3).Row
        If S1.Cells(i, "B") = "İPTAL" Then
        Else
            sat = S2.[A65536].End(3).Row + 1

            S2.Cells(sat, "A") = S1.Cells(i, "A")
            S2.Cells(sat + 1, "A") = S1.Cells(i, "A")
            S2.Cells(sat + 2, "A") = S1.Cells(i, "A")

            S2.Cells(sat, "B") = S1.Cells(i, "B")
            S2.Cells(sat + 1, "B") = S1.Cells(i, "B")
            S2.Cells(sat + 2, "B") = S1.Cells(i, "B")

            S2.Cells(sat, "C") = S1.Cells(i, "B")
            S2.Cells(sat + 1, "C") = S1.Cells(i, "B")
            S2.Cells(sat + 2, "C") = S1.Cells(i, "B")

            S2.Cells(sat, "E") = S1.Cells(i, "D")
            S2.Cells(sat + 1, "E") = S1.Cells(i, "D")
            S2.Cells(sat + 2, "E") = S1.Cells(i, "D")

            Set ara = S3.Range("C:C").Find(S1.Cells(i, "G"), , xlValues, xlWhole)
            If Not ara Is Nothing Then
                S2.Cells(sat + 2, "D") = S3.Cells(ara.Row, "A")
            Else
                S2.Cells(sat + 2, "D") = "Yok"
            End If

            S2.Cells(sat, "F") = S1.Cells(i, "D") & " Ft. " & S1.Cells(i, "A")
            S2.Cells(sat + 1, "F") = S1.Cells(i, "D") & " Ft. " & S1.Cells(i, "A")
            S2.Cells(sat + 2, "F") = S1.Cells(i, "D") & " Ft. " & S1.Cells(i, "A")

            S2.Cells(sat, "H") = S1.Cells(i, "G")
            S2.Cells(sat + 1, "H") = S1.Cells(i, "G")
            S2.Cells(sat + 2, "H") = S1.Cells(i, "G")

            S2.Cells(sat, "G") = S1.Cells(i, "F")
            S2.Cells(sat + 1, "G") = S1.Cells(i, "F")
            S2.Cells(sat + 2, "G") = S1.Cells(i, "F")

            S2.Cells(sat, "I") = "A"
            S2.Cells(sat + 1, "I") = "A"
            S2.Cells(sat + 2, "I") = "B"

            S2.Cells(sat, "D") = "600.01.002"
            S2.Cells(sat + 1, "D") = "391.18.001"

            S2.Cells(sat, "j") = "S"

            If S1.Cells(i, "Z") = "" Then
            Else
                S2.Cells(sat, "K") = WorksheetFunction.Round(S1.Cells(i, "Z"), 2)
                S2.Cells(sat + 1, "L") = WorksheetFunction.Round(S1.Cells(i, "AA"), 2)
                S2.Cells(sat + 2, "M") = WorksheetFunction.Round(S1.Cells(i, "AB"), 2)
            End If
        End If
    Next

    Application.ScreenUpdating = True
    MsgBox " T a m a m l a n d ı"
End Sub

. . .

ovarnali1 · 30 Ocak 2014

Üstadım kod çalıştı çok teşekkürler.

Yalnız benim anlatımımda eksiklikler oluyor bende kodu çalıştırdıktan sonra bunu fark ediyorum tekrar tekrar dönmem bu yüzden.

Vergi No su olmayan hesaplar mevcut o yüzden bunlara hesap kodu atayamıyor. Bu durumda vergi no'suna bakma direkt hesap kodunu yaz diyebilirmiyiz?

Excelden Muhasebe Programına Veri Aktarımı (1 satırı 3 kopya ile çoğaltma)

ovarnali1

Ekli dosyalar

Emir Hüseyin Çoban

Destek Ekibi

Ekli dosyalar

ovarnali1

Emir Hüseyin Çoban

Destek Ekibi

ovarnali1

Ekli dosyalar

Emir Hüseyin Çoban

Destek Ekibi

ovarnali1

Emir Hüseyin Çoban

Destek Ekibi

ovarnali1

Emir Hüseyin Çoban

Destek Ekibi

ovarnali1

ovarnali1

Ekli dosyalar

Emir Hüseyin Çoban

Destek Ekibi

ovarnali1

Ekli dosyalar

Emir Hüseyin Çoban

Destek Ekibi

ovarnali1

Emir Hüseyin Çoban

Destek Ekibi

ovarnali1

Ekli dosyalar

Emir Hüseyin Çoban

Destek Ekibi

ovarnali1