• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

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

cavanoos

cavanoos

Katılım
17 Aralık 2008
Mesajlar
780
Excel Vers. ve Dili
Microsoft 365
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 ?
 
Merhaba,
Kod: 
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
 
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 ?
 

Ekli dosyalar

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
 
Tevfik Bey,

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

Bu soruna başka bir çözüm önerisi olan var mı ?
 
Siz kullandığınız makroyu yazın şuraya belki çözüm daha kolay olur
 
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
 
Merhaba,
makronuzda Set rng = ActiveSheet.UsedRange ifadesini Set rng = ActiveSheet.Range([K1].Text) bu ifade ile değiştirip deneyin.
İyi çalışmalar
 
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 ?
 

Ekli dosyalar

251464

Java ve BDP kurdum test için,

Kod: 
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
 
Son düzenleme:
K1 hücresine ="A1:E"&ARA(2;1/(B:B<>"");SATIR(B:B)) yazınız
 
Sayın Veysel Hocam,
Makronuz yazdığı satırları tırnak içine alıyor.
Saygılarımla
 
Kod: 
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
 
İşte bu güzel oldu. Çok teşekkürler
Saygılarımla
 
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 ?
 
cavanoos' Alıntı:
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 ?
Genişletmek için tıkla ...
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.
 
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 :)
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst