Çözüldü Txt Dosyasında Makro Kodu ile Değiştirme İşlemi

[cavanoos]

Merhaba;

Excel dosyasından txt dosyasına makro ile kopyalama yapıyorum.
A sütunu boş, B sütunu dolu
Böyle olunca txt dosyasına kopyalama yapınca sadece B sütunu kopyalanıyor.
Halbuki boş olan A sütunu da olmalı ama yapamadım.

Alternatif çözüm için A sütununa J harfi koydum.
Txt dosyasına makro ile iki sütun kopyalama yapıyor.

Bu aşamada makro ile J harfini seçip boş karakter ile değiştirmek istedim ama olmuyor.
Bu mümkün mü ?
Ya da yaşadığım bu soruna başkaca bir çözüm var mı ?
Yardımcı olabilir misiniz ?

 

[Tevfik_Kursun]

Merhaba,

Sub Kod()
Open ThisWorkbook.Path & "\Text.txt" For Output As #1
Dim R As Range

Range([K1].Text).Select

Set R = Selection
For a = 1 To R.Rows.Count
    For b = 1 To R.Columns.Count
        If b = R.Columns.Count Then
            Print #1, R.Cells(a, b)
        Else
            Print #1, R.Cells(a, b),
        End If
    Next
Next
Close #1
    Range("A1").Select
End Sub

K1 hücresine hangi alanı text dosyasına katmak istiyorsanız yazınız. (ör: ="A1:K"&BAĞ_DEĞ_DOLU_SAY(B:B)) gibi
İyi çalışmalar

 

[cavanoos]

Tevfik Bey;

Ekli örnek excel dosyasını ekliyorum. İçinde makronuz var. Çalıştırdım ortaya çıkan sonuç text isimli txt dosyasında.
Bir de aktif isimli txt dosyasını ekliyorum. Aktif isimli txt dosyasının tek kusuru JJJ harfleri, bunlar olmayacak.

Sizin text dosyasının kusuru ise; 683.482,85 tutarının önüne geliyorum ve backspace tuşuna basıyorum. Karakter karakter siliyor.
Diğer aktif isimli dosyada ise aynı işlemi yaptığımda direkt J harfine geliyor. Olması gereken bu idi.
Bu dosyayı beyanname programına yükleyeceğim.
Aktif isimli dosyada J harflerini kaldırsam direkt yüklüyor ama text isimli dosyada yüklemiyor. Çünkü sütunlar farklı
Anlatabildim mi ?

 

[Tevfik_Kursun]

Merhaba,
Range([K1].Text).Select
makroda bu satırı silseniz ve istediğiniz alanı seçip makroyu çalıştırırsanız yine size txt dosyası oluşturur. Sanırım sizdeki tab ile yapıyor birleştirmeyi.
İyi çalışmalar

 

[cavanoos]

Tevfik Bey,

İlginiz için teşekkür ederim.

Bu soruna başka bir çözüm önerisi olan var mı ?

 

[Tevfik_Kursun]

Siz kullandığınız makroyu yazın şuraya belki çözüm daha kolay olur

 

[cavanoos]

Dim myFile As String
Dim rng As Range
Dim cellValue As String
Dim i As Integer, j As Integer
Dim desktopPath As String
desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
myFile = desktopPath & "\Aktif.txt"
Open myFile For Output As #1
Set rng = ActiveSheet.UsedRange
For i = 1 To rng.Rows.Count
For j = 1 To rng.Columns.Count
cellValue = rng.Cells(i, j).Value
If cellValue = "" Then
cellValue = " "
End If
Print #1, cellValue;
If j <> rng.Columns.Count Then
Print #1, vbTab;
End If
Next j
Print #1,
Next i
Close #1

 

[Tevfik_Kursun]

Merhaba,
makronuzda Set rng = ActiveSheet.UsedRange ifadesini Set rng = ActiveSheet.Range([K1].Text) bu ifade ile değiştirip deneyin.
İyi çalışmalar

 

[cavanoos]

Tevfik Bey;

Evet şimdi oldu, tek sıkıntı kaldı.
K1 hücresinde dosyada da göreceksiniz. 31. satıra kadar alıyor. Alt satırlar yok.
Bunu 200. satıra kadar çekmek için ne yapabiliriz ?

 

[veyselemre]

Java ve BDP kurdum test için,

Sub txtOlustur()
    Dim desktopPath$, myFile$, i, lRow, al
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    myFile = desktopPath & "\Aktif.txt"
    lRow = Intersect(Range("A:D"), ActiveSheet.UsedRange).Rows.Count
    al = Range("A1:D" & lRow).Value
    Open myFile For Output As #1
    For i = 1 To UBound(al)
        If al(i, 2) & al(i, 3) & al(i, 4) <> "" Then
            Write #1, vbTab & al(i, 2) & vbTab & al(i, 3) & vbTab & al(i, 4)
        Else
            Write #1, ""
        End If
    Next i
    Close #1
End Sub

 

[Tevfik_Kursun]

K1 hücresine ="A1:E"&ARA(2;1/(B:B<>"");SATIR(B:B)) yazınız

 

[Tevfik_Kursun]

Sayın Veysel Hocam,
Makronuz yazdığı satırları tırnak içine alıyor.
Saygılarımla

 

[veyselemre]

Sayın Veysel Hocam,
Makronuz yazdığı satırları tırnak içine alıyor.
Saygılarımla

Write yerine Print olursa tırnak içine almaz. BDP her ikisinde de sıkıntı çıkarmıyor.

 

[veyselemre]

Sub txtOlustur2()
    Dim desktopPath$, myFile$, i, lRow, dataObj
    Set dataObj = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    desktopPath = CreateObject("WScript.Shell").SpecialFolders("Desktop")
    myFile = desktopPath & "\Aktif.txt"
    lRow = Intersect(Range("A:D"), ActiveSheet.UsedRange).Rows.Count
    Range("A1:D" & lRow).Copy
    Open myFile For Output As #1
    dataObj.getFromClipboard
    Print #1, dataObj.getText
    Close #1
    Application.CutCopyMode = False
End Sub

 

[Tevfik_Kursun]

İşte bu güzel oldu. Çok teşekkürler
Saygılarımla

 

[cavanoos]

Tevfik Bey ve Veysel Bey;

İkinizinde yazdığı kodlar tam istediğim gibi çalışır, eksik olmayın, emeğinize sağlık.

Siz muhasebecisiniz galiba Veysel Bey;

Beyannamedeki aktif, pasif ve gelir tablosunu manuel olarak değil de excelden aktarabilir miyim diyerekten çalışmaya başladım.
Aktif bölümünü bitirdim, şimdi diğerlerine başlayacağım inşallah.
Sizin elinizde bu durum için hazır bir excel çalışması var mı ?
Varsa ben boşuna vakit kaybetmeyeyim ?

 

[veyselemre]

Siz muhasebecisiniz galiba Veysel Bey;

Beyannamedeki aktif, pasif ve gelir tablosunu manuel olarak değil de excelden aktarabilir miyim diyerekten çalışmaya başladım.
Aktif bölümünü bitirdim, şimdi diğerlerine başlayacağım inşallah.
Sizin elinizde bu durum için hazır bir excel çalışması var mı ?
Varsa ben boşuna vakit kaybetmeyeyim ?

Muhasebeci değilim de ebeyannamenin ilk çıktığı yıllarda epey uğraşmıştım. Excel'den beyanname oluşturma, paketleme, gönderme, otomatik pdf indirme, pdflerin beyanname cinslerini dönemlerini watermark olarak yan tarafına ekliyordum, otomatik bir yaprakta 2 sayfa yazdırma vs. her şeyi yapıyordum. Sonra Zirveye geçtiler hepsi boş oldu. Sizin kullandığınız program bu işleri yapmıyor mu, neden uğraşıyorsunuz anlamadım.

 

[cavanoos]

Nebim programı kullanıyoruz.
Şu ana dek bu sorgulamayı hiç yapmadım, olabileceğini düşünmemiştim, belki vardır. Pazartesi günü bakacağım.

Teşekkür ederim, ufkumu açıyorsunuz, bugün verimli bir gün oldu