Bu formüldeki hata nerede..

[Necdet]

Merhaba,

Son kodlar tekrar kısaldı, onu incelediniz mi?

 

[yorum.halil]

Merhaba,

Son kodlar tekrar kısaldı, onu incelediniz mi?

Evet üstadım yeni kodları gördüm.. Çok daha güzel oldu.... Kendimi Medine dilencisi gibi hissedeceğim ama olsun yinede söyleyeceğim

Allah seni ve senin gibileri bu forumdan eksik etmesin

 

[Necdet]

Halil Bey,

Goca rabbımı karıştırmayın şurda güzel güzel birbirimize bilgilerimizi aktarıyoruz işte, elimizden geldiğinde

Güle güle kullanınız.

 

[yorum.halil]

Öncelikle hepinizin Mevlid Kandiliniz Mübarek Olsun... Arkadaşlar.... Üstadlar... Ufak bir sorum daha olacak... Makro ile txt dosyası oluşturduğu zaman rakam kuruşlu değilse rakamın sonuna ",00" yazmıyor.. Yani txt dosyası oluştururken "100" yerine "100,00" yazmasını istiyorum. Sanırım vba da bir yerlerin değişmesi lazım. Acaba bunu düzeltmek için ne yapmamız gerekir...

YANİ EXCEL SAYFASINDA NASIL GÖRÜNÜYORSA O ŞEKİLDE TXT OLUŞSUN...TŞK..

ÖRNEK
041 1875 375 ===> YALNIŞ

041 1875,00 375,00 ===> DOĞRU

 

[Necdet]

Sayın hemşehrim,

İstemelisiniz hemde çok istemelisiniz, yardımcı olabilirsem ne mutlu bana, ama yardımcı olamazsam yardım eden arkadaşlardan da bende birşeyler öğrenmiş olurum.

Amaç hep berebar bilgimizi paylaşmak, öğrenmek ve öğrendiklerimizi anlatmak.

Saygılar.

 

[yorum.halil]

Sayın hemşehrim,

İstemelisiniz hemde çok istemelisiniz, yardımcı olabilirsem ne mutlu bana, ama yardımcı olamazsam yardım eden arkadaşlardan da bende birşeyler öğrenmiş olurum.

Amaç hep berebar bilgimizi paylaşmak, öğrenmek ve öğrendiklerimizi anlatmak.

Saygılar.

Sayın üstadım Sayende dosyanın büyük bir kısmı bitti. Çok tşk... Ayrıca dediklerine Aynen katılıyorum....Elbet vardır bununda bir çaresi.... bekleyelim görelim....... Tekrar hayırlı Kandiller....

 

[Ferhat Pazarçevirdi]

Necdet hocam, yettim gali

Gerçi; "Pişmiş aşa su katılmaz derler" ama ...

Sizin kodlardaki, Kayıt = Kayıt & Chr(9) & e.Cells(x, y) satırını formatlasak da şöyle denesek olur mu acep ?

Kayıt = Kayıt & Chr(9) & Format(e.Cells(x, y), "0,00")

 

[yorum.halil]

Necdet hocam, yettim gali

Gerçi; "Pişmiş aşa su katılmaz derler" ama ...

Sizin kodlardaki, Kayıt = Kayıt & Chr(9) & e.Cells(x, y) satırını formatlasak da şöyle denesek olur mu acep ?

Kayıt = Kayıt & Chr(9) & Format(e.Cells(x, y), "0,00")

Olmadı be Ferhat Usta.. Bu şekilde elimizdeki kuruşlardan da olduk beee Kuruş muruş kalmadı...

Eski Hali =====> 011........ 9135...... 1164,71
Yeni Hali =====> 011........9135.......1165

 

[Korhan Ayhan]

Selamlar,

Aşağıdaki şekilde denermisiniz.

Kayıt = Kayıt & Chr(9) & Format(e.Cells(x, y), "0[B][COLOR=red].[/COLOR][/B]00")

 

[Ferhat Pazarçevirdi]

Eeee Halil bey, eski cumhurbaşkanlarımızdan Cemal Gürsel ilk Türk otomobili Devrim olayını yaşadığında, şu cümleyi sarfetmiş :"Batı kafasıyla otomobil yapıp, Doğu kafasıyla işletmektesiniz"

Kıssadan hisse ...

Doğrudur. Formatta "0,00" diye yazdığımız ibareyi "0.00" şeklinde (virgül yerine nokta koyarak) düzeltiniz.

 

[yorum.halil]

Selamlar,

Aşağıdaki şekilde denermisiniz.

Kayıt = Kayıt & Chr(9) & Format(e.Cells(x, y), "0[B][COLOR=red].[/COLOR][/B]00")

Aha.... valla geldi kuruşlar..... Yavvvv üstadlar hepinizin eline sağlık....Allah klavyenize zeval vermesin.... Allah Hepinizden razı olsun.... Şu mübarek günde büyük sevaba girdiniz....

 

[Necdet]

Oooo burada sohbet baya iyiymiş, geç kalmışım

 

[Korhan Ayhan]

Selamlar,

Özel mesaj atarak size önerilen kodların kendi dosyanızda sağlıklı çalışmadığını belirtmişsiniz.

Aşağıdaki şekilde düzeneyip denermisiniz.

Sub txtolustur()
On Error Resume Next
'KLASÖR AÇMA-------------------------------------------------------------------------------
Sheets("MUHTASAR").Select
If Right([Q8], 1) <> "\" Then [Q8] = [Q8] & "\"
If Dir([Q8]) = "" Then MkDir ([Q8])
ActiveWorkbook.Save
'&#304;CMAL.TXT OLU&#350;TURMA TANIMLARI-------------------------------------------------------------
Open Sheets("MUHTASAR").[Q8] & Sheets("MUHTASAR").[Q3] & "-ICMAL" & ".txt" For Output As #1
Set e = Sheets("ICMAL")
For x = 1 To e.[A65536].End(3).Row
    If e.Cells(x, "A") <> "0" And e.Cells(x, "A") <> "" Then
       Kay&#305;t = Format(e.Cells(x, 1), "000")
       For y = 2 To 3  'BURADAK&#304; 10 S&#220;TUN SAYISINI G&#214;STER&#304;R,
            If Len(Round(Format(e.Cells(x, y), "0.00"), 2)) - Len(Int(Round(Format(e.Cells(x, y), "0.00"), 2))) = 0 Then
            Kay&#305;t = Kay&#305;t & vbTab & WorksheetFunction.Rept(" ", 12 - Len(Round(Format(e.Cells(x, y), "0.00"), 2))) & Format(e.Cells(x, y), "0.00")
            Else
            Kay&#305;t = Kay&#305;t & vbTab & WorksheetFunction.Rept(" ", 15 - Len(Round(Format(e.Cells(x, y), "0.00"), 2))) & Format(e.Cells(x, y), "0.00")
            End If
       Next
       Print #1, Kay&#305;t
    End If
Next
    Close #1
'LISTE.TXT OLU&#350;TURMA TANIMLARI-------------------------------------------------------------
Open Sheets("MUHTASAR").[Q8] & Sheets("MUHTASAR").[Q3] & "-LISTE" & ".txt" For Output As #1
Set e = Sheets("LISTE")
For x = 1 To e.[A65536].End(3).Row
    If e.Cells(x, "A") <> "0" And e.Cells(x, "A") <> "" Then
       Kay&#305;t = e.Cells(x, 1)
       For y = 2 To 8  'BURADAK&#304; 10 S&#220;TUN SAYISINI G&#214;STER&#304;R
            If y = 4 Or y = 5 Then
            Kay&#305;t = Kay&#305;t & vbTab & e.Cells(x, y)
            ElseIf y = 6 Then
            Kay&#305;t = Kay&#305;t & vbTab & Format(e.Cells(x, y), "000")
            ElseIf y > 6 Then
            If Len(Round(Format(e.Cells(x, y), "0.00"), 2)) - Len(Int(Round(Format(e.Cells(x, y), "0.00"), 2))) = 0 Then
            Kay&#305;t = Kay&#305;t & vbTab & WorksheetFunction.Rept(" ", 12 - Len(Round(Format(e.Cells(x, y), "0.00"), 2))) & Format(e.Cells(x, y), "0.00")
            Else
            Kay&#305;t = Kay&#305;t & vbTab & WorksheetFunction.Rept(" ", 15 - Len(Round(Format(e.Cells(x, y), "0.00"), 2))) & Format(e.Cells(x, y), "0.00")
            End If
            Else
            Kay&#305;t = Kay&#305;t & vbTab & e.Cells(x, y)
            End If
       Next
       Print #1, Kay&#305;t
    End If
Next
    Close #1
'MESAJ OLU&#350;TURMA TANIMLARI-------------------------------------------------------------
     MsgBox [Q3] & " Firmas&#305;n&#305;n " & [Q7] & " D&#246;nemine Ait Txt Dosyalar&#305; " & [Q8] & " Klas&#246;r&#252;ne Ba&#351;ar&#305; &#304;le Kaydedilmi&#351;tir", vbInformation
End Sub

 

[yorum.halil]

Üstadım çok teşekkürler... Çok yakında dosyayı sizlerle paylaşacağım...