Bu formüldeki hata nerede..

Katılım
16 Aralık 2007
Mesajlar
151
Excel Vers. ve Dili
Office 2007
Arkadaşlar bir üstadımızın dosyasını kendime uyarlamaya çalıştım fakat makro ERTAN isimli sayfada çalışırken BİLGİ isimli sayfada çalışmıyor...

Çalışıyor fakat ERTAN isimli sayfadaki verileri alması gerekirlen "BİLGİ" isimli sayfaki verileri alıyor.. Konu ile ilgili gerekli açıklamalar dosyada mevcut. Ama sanırım aşağıda ki satırlarda bir düzenleme yapılması gerekli. Help.... :)

For x = 1 To Sheets("ERTAN").Range("O1")
For y = 1 To 11
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,260
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Sonucu tam denemedim, siz dener misiniz?

Kod:
Sub ortaktxtolustur()
ActiveWorkbook.Save
Open Sheets("bilgi").Range("b1") & Sheets("bilgi").Range("b2") & ActiveSheet.Name & ".txt" For Output As #1
Dim al(100, 11)
[B][COLOR=red]Set e = Sheets("ERTAN")[/COLOR][/B]
For x = 1 To [COLOR=red][B]e.[A65536].End(3).Row[/B][/COLOR]
    For y = 1 To 11
        al(x, y) = [B][COLOR=red]e.[/COLOR][/B]Cells(x, y)
    Next
 
    al(x, 11) = Replace(al(x, 11), ".", ",")
    kayit = al(x, 1) & Chr(9) & al(x, 2) & Chr(9) & al(x, 3) & Chr(9) & al(x, 4) & Chr(9) & al(x, 5) & Chr(9) & al(x, 6) & Chr(9) & al(x, 7) & Chr(9) & al(x, 8) & Chr(9) & al(x, 9) & Chr(9) & al(x, 10) & Chr(9) & al(x, 11)
    Print #1, kayit
Next
    Close #1
    MsgBox " Aktarım yapıldı.", vbInformation, " Bilgilendirme"
End Sub
 
Katılım
16 Aralık 2007
Mesajlar
151
Excel Vers. ve Dili
Office 2007
Üstadım verdiğin kodlama oldu. Tşk. Elinize sağlık.....Sizden bir ricam daha olacak... txt dosyasının kaydedileceği yeri B1 hücresinde belirtiyoruz. Ama "B1" hücresinde belirlilen klasör olmadığı zaman "....... isimli klasör yok açılsın mı" gibi bir bölüm eklemek mümkünmü acaba...

Birde en sondaki MsgBox bölümünde "AKTARIM YAPILDI" yerine "...... FİRMASININ AKTARIMI YAPILDI" yapabilirmiyiz. Yani mesaj bölümünde firmanın ismide yazsın.. Sizin eklediğiniz koda göre yapılan dosya ektedir. İlginiz için şimdiden tşk. ederim.
 
Son düzenleme:

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,260
Excel Vers. ve Dili
Ofis 365 Türkçe
İyi geceler,

Kodları dener misiniz?


Kod:
Sub ortaktxtolustur()
Sheets("BILGI").Select
If Right([B1], 1) <> "\" Then [B1] = [B1] & "\"
If Dir([B1]) = "" Then
    Evet = InputBox([B1] & " Adl&#305; Dizini Bulamad&#305;m, Olu&#351;turay&#305;m m&#305;? (E/H)", "Klas&#246;r Olu&#351;turma", "H")
    If Evet = "E" Or Evet = "e" Then
        MkDir ([B1])
    Else
        MsgBox [B1] & " Klas&#246;r&#252;n&#252; A&#231;&#305;ktan Sonra &#199;al&#305;&#351;mak &#220;zere Ho&#351;&#231;akal&#305;n&#305;z..."
        Exit Sub
    End If
End If
ActiveWorkbook.Save
Open Sheets("BILGI").Range("b1") & Sheets("BILGI").Range("b2") & "-ICMAL" & ".txt" For Output As #1
Dim al(20, 11)
Set e = Sheets("ERTAN")
For x = 1 To e.[A65536].End(3).Row
    For y = 1 To 11
        al(x, y) = e.Cells(x, y)
    Next
 
    al(x, 11) = Replace(al(x, 11), ".", ",")
    kayit = al(x, 1) & Chr(9) & al(x, 2) & Chr(9) & al(x, 3) & Chr(9) & al(x, 4) & Chr(9) & al(x, 5) & Chr(9) & al(x, 6) & Chr(9) & al(x, 7) & Chr(9) & al(x, 8) & Chr(9) & al(x, 9) & Chr(9) & al(x, 10) & Chr(9) & al(x, 11)
    Print #1, kayit
 
Next
    Close #1
Open Sheets("BILGI").Range("b1") & Sheets("BILGI").Range("b2") & "-LISTE" & ".txt" For Output As #1
Set e = Sheets("LISTE")
For f = 1 To e.[A65536].End(3).Row
    For g = 1 To 11
        al(f, g) = e.Cells(f, g)
    Next
    al(f, 11) = Replace(al(f, 11), ".", ",")
    kayit = al(f, 1) & Chr(9) & al(f, 2) & Chr(9) & al(f, 3) & Chr(9) & al(f, 4) & Chr(9) & al(f, 5) & Chr(9) & al(f, 6) & Chr(9) & al(f, 7) & Chr(9) & al(f, 8) & Chr(9) & al(f, 9) & Chr(9) & al(f, 10) & Chr(9) & al(f, 11)
    Print #1, kayit
Next
    Close #1
     MsgBox [B2] & " Firmas&#305;n&#305;n Bilgileri Aktar&#305;ld&#305;....", vbInformation, " BILGIlendirme"
End Sub
 
Katılım
16 Aralık 2007
Mesajlar
151
Excel Vers. ve Dili
Office 2007
Üstadım verdiğin kodlar oldu. Siz değerli üstadlarımdan son bir şey daha isteyeceğim. Txt dosyasınının oluşturulduğu sayfa başka bir sayfadan veri alacak... Ama ilgili satır o ay işlem görmediği zaman satır boş kalacak...

Sizlerden isteğim şu.. Txt dosyasını oluştururken boş satırlar iptal edilebilirmi... Yada bir nev'i sıralama yaptırabilirmiyiz... Ekteki dosyada bununla ilgili açıklama ve örnekler var... Yardımlarımız için şimdiden tşk ediyorum..
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,260
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Bo&#351; sat&#305;rlar&#305; sildirsek san&#305;r&#305;m olur.

Kod:
Sub ortaktxtolustur()
[B][COLOR=red]On Error Resume Next
[/COLOR][/B]Sheets("BILGI").Select
If Right([B1], 1) <> "\" Then [B1] = [B1] & "\"
If Dir([B1]) = "" Then
    Evet = InputBox([B1] & " &#304;S&#304;ML&#304; KLAS&#214;R BULUNAMADI.          &#350;&#304;MD&#304; A&#199;MAK &#304;STERM&#304;S&#304;N&#304;Z ? (EVET/HAYIR)", "Klas&#246;r Olu&#351;turma", "H")
    If Evet = "E" Or Evet = "e" Then
        MkDir ([B1])
    Else
        MsgBox [B1] & " KLAS&#214;R&#220; A&#199;ILMADAN &#304;&#350;LEME DEVAM EDEMEZS&#304;N&#304;Z"
        Exit Sub
    End If
End If
ActiveWorkbook.Save
Open Sheets("BILGI").Range("b1") & Sheets("BILGI").Range("b2") & "-ICMAL" & ".txt" For Output As #1
Dim al(20, 11)
Set e = Sheets("ERTAN")
    
[B][COLOR=red]e.Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete[/COLOR][/B]
For x = 1 To e.[A65536].End(3).Row
    For y = 1 To 11
        al(x, y) = e.Cells(x, y)
    Next
 
    al(x, 11) = Replace(al(x, 11), ".", ",")
    kayit = al(x, 1) & Chr(9) & al(x, 2) & Chr(9) & al(x, 3) & Chr(9) & al(x, 4) & Chr(9) & al(x, 5) & Chr(9) & al(x, 6) & Chr(9) & al(x, 7) & Chr(9) & al(x, 8) & Chr(9) & al(x, 9) & Chr(9) & al(x, 10) & Chr(9) & al(x, 11)
    Print #1, kayit
 
Next
    Close #1
Open Sheets("BILGI").Range("b1") & Sheets("BILGI").Range("b2") & "-LISTE" & ".txt" For Output As #1
Set e = Sheets("LISTE")
For f = 1 To e.[A65536].End(3).Row
    For g = 1 To 11
        al(f, g) = e.Cells(f, g)
    Next
    al(f, 11) = Replace(al(f, 11), ".", ",")
    kayit = al(f, 1) & Chr(9) & al(f, 2) & Chr(9) & al(f, 3) & Chr(9) & al(f, 4) & Chr(9) & al(f, 5) & Chr(9) & al(f, 6) & Chr(9) & al(f, 7) & Chr(9) & al(f, 8) & Chr(9) & al(f, 9) & Chr(9) & al(f, 10) & Chr(9) & al(f, 11)
    Print #1, kayit
Next
    Close #1
     MsgBox [B2] & " F&#304;RMASINA A&#304;T TXT DOSYASI BA&#350;ARI &#304;LE OLU&#350;TURULDU", vbInformation, "TEBR&#304;KLER"
End Sub
 
Son düzenleme:
Katılım
16 Aralık 2007
Mesajlar
151
Excel Vers. ve Dili
Office 2007
Üstadım.. Satırlar arasında boşluk olduğu zaman sorun yok düzgün bir şekilde boş satırları siliyor... Fakat boşluk olmadığı zaman ise "Run-time error 1004" hatasını veriyor...
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,260
Excel Vers. ve Dili
Ofis 365 Türkçe
h&#305;mmm onu atlam&#305;&#351;&#305;m.

O sat&#305;r&#305;n ba&#351;&#305;na yada makronun ba&#351;&#305;na On Error Resume Next ibaresini ekler misiniz.
 
Katılım
16 Aralık 2007
Mesajlar
151
Excel Vers. ve Dili
Office 2007
&#220;stad&#305;m eline eme&#287;ine sa&#287;l&#305;k... valla h&#305;z&#305;r gibi yeti&#351;tin....
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,260
Excel Vers. ve Dili
Ofis 365 Türkçe
G&#252;le g&#252;le kullan&#305;n&#305;z, yukar&#305;daki mesaj&#305; da d&#252;zeltmi&#351; olal&#305;m da, eksik olmas&#305;n.
 
Katılım
17 Mart 2008
Mesajlar
2
Excel Vers. ve Dili
excel 2003
Arkadaşlar öncelikle böyle bir forumu keşfettiğim için çok memnun olduğumu belirtmek isterim. Gerçekten çok güzel dosyalar var... Muhasebe işi ile uğraştığım için bu dosya benimde çok işme yarayacak. Bu nedenle herkese tekrar tşk. ederim. Yalnız ben bu dosya ile ilgili ufak bir ricam olacak..

B1 hücresine göre klasörü açarken EVET/HAYIR diye sormadan direk açılması için ne yapmamız gerekir... YAni klsör yoksa oluştursun... varsa direk dosyaları onun içine oluştursun...
 
Katılım
17 Mart 2008
Mesajlar
2
Excel Vers. ve Dili
excel 2003
Birde &#252;stad&#305;m san&#305;r&#305;m bir eksik daha var...halil arkada&#351;&#305;m&#305;z fark etmedi san&#305;r&#305;m. Halil arkada&#351;&#305;m&#305;z&#305;nda dedi&#287;i gibi ERTAN VE L&#304;STE isimli sayfalar ba&#351;ka sayfalardan veri alacak.. ama txt dosyas&#305; olu&#351;tururken sat&#305;rlar&#305; sildi&#287;i i&#231;in otomatikmen verileri almas&#305; i&#231;in yaz&#305;lan form&#252;lleride siliyor... Yani bunun ba&#351;ka bir yolu olmal&#305;.
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,260
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Dizin yoksa hemen dizini olu&#351;turur.
Bo&#351; sat&#305;rlar&#305; silmeden liste olu&#351;turur.


Kod:
Sub ortaktxtolustur()
On Error Resume Next
Sheets("BILGI").Select
If Right([B1], 1) <> "\" Then [B1] = [B1] & "\"
If Dir([B1]) = "" Then MkDir ([B1])
ActiveWorkbook.Save
Open Sheets("BILGI").Range("b1") & Sheets("BILGI").Range("b2") & "-ICMAL" & ".txt" For Output As #1
Dim al(20, 11)
Set e = Sheets("ERTAN")
 
For x = 1 To e.[A65536].End(3).Row
   [COLOR=red][B] If e.Cells(x, "A") <> "0" And e.Cells(x, "A") <> "" Then[/B][/COLOR]
       For y = 1 To 11
           al(x, y) = e.Cells(x, y)
       Next
 
       al(x, 11) = Replace(al(x, 11), ".", ",")
       kayit = al(x, 1) & Chr(9) & al(x, 2) & Chr(9) & al(x, 3) & Chr(9) & al(x, 4) & Chr(9) & al(x, 5) & Chr(9) & al(x, 6) & Chr(9) & al(x, 7) & Chr(9) & al(x, 8) & Chr(9) & al(x, 9) & Chr(9) & al(x, 10) & Chr(9) & al(x, 11)
       Print #1, kayit
    End If
Next
    Close #1
Open Sheets("BILGI").Range("b1") & Sheets("BILGI").Range("b2") & "-LISTE" & ".txt" For Output As #1
Set e = Sheets("LISTE")
For f = 1 To e.[A65536].End(3).Row
   [COLOR=red][B] If e.Cells(f, "A") <> "0" And e.Cells(f, "A") <> "" Then[/B][/COLOR]
        For g = 1 To 11
            al(f, g) = e.Cells(f, g)
        Next
        al(f, 11) = Replace(al(f, 11), ".", ",")
        kayit = al(f, 1) & Chr(9) & al(f, 2) & Chr(9) & al(f, 3) & Chr(9) & al(f, 4) & Chr(9) & al(f, 5) & Chr(9) & al(f, 6) & Chr(9) & al(f, 7) & Chr(9) & al(f, 8) & Chr(9) & al(f, 9) & Chr(9) & al(f, 10) & Chr(9) & al(f, 11)
        Print #1, kayit
    End If
Next
    Close #1
     MsgBox [B2] & " F&#304;RMASINA A&#304;T TXT DOSYASI BA&#350;ARI &#304;LE OLU&#350;TURULDU", vbInformation, "TEBR&#304;KLER"
End Sub
 
Son düzenleme:
Katılım
16 Aralık 2007
Mesajlar
151
Excel Vers. ve Dili
Office 2007
&#252;stad&#305;m acemix06 karde&#351;imizin dedi&#287;i gibi ertan ve bilgi sayfalar&#305; ba&#351;ka yerden veri al&#305;yor bu nedenle form&#252;ll&#252; olacak... Onun dedi&#287;i gibi d&#252;zeltmi&#351;sin... t&#351;k.. nede olsa akl&#305;n yolu birdir...

E&#287;er k&#305;zmazsan&#305;z bizden kaynaklanan ufak bir hata daha var... Onu d&#252;zeltirseniz sevirinim... Dedi&#287;imiz gibi h&#252;creler form&#252;ll&#252; olaca&#287;&#305; i&#231;in veri ald&#305;&#287;&#305; yer bo&#351;sa h&#252;cre "0" S&#305;f&#305;r olarak yaz&#305;yor ve txt dosyas&#305;n&#305;da buna g&#246;re olu&#351;turuyor...

M&#252;mk&#252;nse txt dosyas&#305;n&#305; olu&#351;tururken bo&#351; sat&#305;r olarak de&#287;ilde de&#287;ilde "0" S&#305;f&#305;r yazan sat&#305;rlar&#305; almadan olu&#351;turabilirmi..

Birde varsa olu&#351;turmas&#305;n yoksa olu&#351;tursun... &#199;&#252;nk&#252; klas&#246;rlerin i&#231;inde ba&#351;ka dosyalarda var.. Ama klas&#246;r&#252; her seferinde silip yeniden olu&#351;turdu&#287;u i&#231;in di&#287;er dosyalarda siliniyor :)

&#220;stad&#305;m bu arada hakk&#305;n&#305;z&#305; helal edin...
 
Son düzenleme:

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,260
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

13. mesajda kırmızı olarak işaretlediğim satırın silinmesi gerekiyordu, onu unutmuşum.

Bu durumda A sütununda hücre boşsa text dosyasına o satırı yazmıyor zaten.

Dizin varsa o dizini zaten açmıyor. Dolayısı ile klasör ve içindeki dosyalar olduğu gibi duruyor, onlara dokunmaz. Ama ilgili text dosyası her seferinde yeniden oluşturur.
 
Katılım
16 Aralık 2007
Mesajlar
151
Excel Vers. ve Dili
Office 2007
Üstad dediğin gibi "A" sütünu boşsa txt dosyası oluştururken sorun olmuyor. Fakat hücre formüllü olduğu için ve veri aldığı hücrede değer olmadığı için A sütunu ve yanındaki hücreler "0" olarak veriyor. Ekteki örnek txt dosyasının 3.satırına bakarsanız anlarsınız. Tşk..
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,260
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Sizin g&#246;nderdi&#287;iniz dosyada hi&#231; form&#252;l g&#246;r&#252;nmedi&#287;i i&#231;in her olas&#305;l&#305;&#287;&#305; d&#252;&#351;&#252;nmek zor tabi, hele hele bilmeden bir&#351;eyleri &#231;&#246;zmek daha da zor :).

Bir deneme daha yapt&#305;m, 13. mesajdaki kodlar&#305; deneyebilir misiniz?
 
Katılım
16 Aralık 2007
Mesajlar
151
Excel Vers. ve Dili
Office 2007
Merhaba,

Sizin gönderdiğiniz dosyada hiç formül görünmediği için her olasılığı düşünmek zor tabi, hele hele bilmeden birşeyleri çözmek daha da zor :).

Bir deneme daha yaptım, 13. mesajdaki kodları deneyebilir misiniz?
Üstadım dosya henüz yapım aşamasında olduğu için formül işleri bitmedi.. Sayende büyük bir kısmı bitti.. Tamamı biter bitmez sizlerle paylaşacağım... Eline emeğine klavyene sağlık....

Ha bu arada dosyayı görmesende yaptığın denemeler başarılı :)
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,260
Excel Vers. ve Dili
Ofis 365 Türkçe
Tekrar merhaba,

&#350;imdi s&#305;ra kodlar&#305; k&#305;saltmaya geldi :) a&#351;a&#287;&#305;daki kodlar&#305; deneyebilir misiniz?

Kod:
Sub ortaktxtolustur()
On Error Resume Next
Sheets("BILGI").Select
If Right([B1], 1) <> "\" Then [B1] = [B1] & "\"
If Dir([B1]) = "" Then MkDir ([B1])
ActiveWorkbook.Save
For i = 1 To 2
    If i = 1 Then
        Set e = Sheets("ERTAN")
        Ek = "-ICMAL"
    Else
        Set e = Sheets("LISTE")
        Ek = "-LISTE"
    End If
    Open [B1] & [B2] & Ek & ".txt" For Output As #1
    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 11
                Kay&#305;t = Kay&#305;t & Chr(9) & e.Cells(x, y)
           Next
           Print #1, Kay&#305;t
        End If
    Next
        Close #1
Next i
     MsgBox [B2] & " F&#304;RMASINA A&#304;T TXT DOSYASI BA&#350;ARI &#304;LE OLU&#350;TURULDU", vbInformation, "TEBR&#304;KLER"
End Sub
 
Son düzenleme:
Katılım
16 Aralık 2007
Mesajlar
151
Excel Vers. ve Dili
Office 2007
&#220;stad&#305;m..... Ankaral&#305; hem&#351;ehrim tekrar eline sa&#287;l&#305;k bende b&#246;yle bir &#351;ey isteyecektim ama inan y&#252;z&#252;m kalmad&#305;... Eeee ne demi&#351; atalar&#305;m&#305;z k&#246;r&#252;n istedi&#287;i bir g&#246;z Allah verdi iki g&#246;z.... Allah klavyene zeval vermesin....T&#351;k.
 
Üst