• DİKKAT

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

Save as Path is wrong

L

Lecay

Katılım
3 Ekim 2011
Mesajlar
89
Excel Vers. ve Dili
Excel 2013 ENG
Arkadaşlar selamlar,

Ekli dosyada .txt oluşturmaya çalıştığımda hata alıyorum. Amacım 15.000'er satırlık ayrı ayrı .txt dosyaları oluşturmak. Txt dosya isimlerini part'lara göre ayarlamaya çalıştım ama olmadı. Yardım edebilme şansınız var mı?

Teşekkürler,
 

Ekli dosyalar

Merhaba.

Kodlarınızda dosya yolu belirtirken bir hata yapıyorsunuz.
Olası hatalar.
1- Path = "C:\Desktop" bu klasör yolu varmı kontrol edin.
2- myfilename = Range("B1") B1 hücresinde yazan metni kontrol edin. Boş olabilir mi?
Ayrıca farklı dosyalar ile çalıştığınız için hangi dosya ve hangi sayfanın B1 hücresi olduğunu da belirtmelisiniz.
Örneğin; B1 hücresi kodların çalıştığı dosya ise şöyle yazabilirsiniz Thisworkbook.Worksheet("SayfaAdı").range("B1")

Muhtemelen artık hata vermeyecektir.
 
dalgalikur' Alıntı:
Merhaba.

Kodlarınızda dosya yolu belirtirken bir hata yapıyorsunuz.
Olası hatalar.
1- Path = "C:\Desktop" bu klasör yolu varmı kontrol edin.
2- myfilename = Range("B1") B1 hücresinde yazan metni kontrol edin. Boş olabilir mi?
Ayrıca farklı dosyalar ile çalıştığınız için hangi dosya ve hangi sayfanın B1 hücresi olduğunu da belirtmelisiniz.
Örneğin; B1 hücresi kodların çalıştığı dosya ise şöyle yazabilirsiniz Thisworkbook.Worksheet("SayfaAdı").range("B1")

Muhtemelen artık hata vermeyecektir.
Genişletmek için tıkla ...

Dalgalikur selamlar,

1- Path = "C:\Desktop" bu klasör yolu varmı kontrol edin. -> Burada herhangi bir hata yok. Adres doğru.
2- myfilename = Range("B1") B1 hücresinde yazan metni kontrol edin. Boş olabilir mi? -> haklısınız, bu alanı daha spesifikleştirdim.

Fakat yine hata veriyor. Şöyle ki; .txt dosyalarını oluşturmaya başladığında B1'i esas alarak 1-2-3-4 diye devam etmesi gerekirken 4'ten başlıyor ilk parçayı kaydediyor; 2 parçayı seçtiğinde kaydetmeden hata ekranı çıkarıyor. Şuanda isimde takılıyorum sanırım.

Teşekkürler,
 

Ekli dosyalar

ActiveWorkbook.SaveAs satırından önce msgbox ile kayıt yolunu kontrol etmek için aşağıdaki gibi deneyin

Kod: 
 MsgBox Path & "\" & myfilename & ".txt"
ActiveWorkbook.SaveAs Filename:=Path & "\" & myfilename & ".txt", FileFormat:=xlNormal
 
dalgalikur' Alıntı:
ActiveWorkbook.SaveAs satırından önce msgbox ile kayıt yolunu kontrol etmek için aşağıdaki gibi deneyin

Kod: 
 MsgBox Path & "\" & myfilename & ".txt"
ActiveWorkbook.SaveAs Filename:=Path & "\" & myfilename & ".txt", FileFormat:=xlNormal
Genişletmek için tıkla ...

Denedim adres doğru fakat dediğim gibi dosya isimlerinde bir karışıklık söz konusu oluyor. Dosyaları sürekli 4.txt olarak kaydetmeye çalışıyor. Oysa ki ben B1 hücresindeki subtotal değerine göre kaydetmesini istiyorum.
 

Ekli dosyalar

Yani B1'de 4 yazıyorsa 4,3,2,1 diye mi kaydetsin?

O zaman aşağıdaki gibi kayıttan sonra "myfilename" değerini 1 düşürün.

Kod: 
ActiveWorkbook.SaveAs Filename:=Path & "\" & myfilename & ".txt", FileFormat:=xlNormal
myfilename=myfilename-1
 
dalgalikur' Alıntı:
Yani B1'de 4 yazıyorsa 4,3,2,1 diye mi kaydetsin?

O zaman aşağıdaki gibi kayıttan sonra "myfilename" değerini 1 düşürün.

Kod: 
ActiveWorkbook.SaveAs Filename:=Path & "\" & myfilename & ".txt", FileFormat:=xlNormal
myfilename=myfilename-1
Genişletmek için tıkla ...

E4 hücresinde seçilen 15.000 satırlık part'ın numarası ne ise onu yazmasını istiyorum aslında. Sizin söylediğinize yakın yani. Makro E4 hücresinden filtreleme yaptıkça B1'deki subtotal formulü kendisini update ediyor ama kod o hücreyi kullanmıyor. 4 değerini sabit alıyor.

Bu arada sizin belirttiniz eki uyguladım koda fakat bu sefer döngü son part'ta durmadı.
 

Ekli dosyalar

Aşağıdaki kod istediğinizi yapıyor.

Kod: 
Sub Macro4()
    Dim Path As String
    Dim myfilename As String
    Path = "C:Desktop"
    Set j = Worksheets("Sheet1").Range("E4")
    i = 0
        Do Until i = j
        Workbooks("POD1.xlsm").Activate
        Workbooks("POD1.xlsm").Worksheets("Sheet1").Select
        ActiveSheet.Range("E:E").AutoFilter Field:=5, Criteria1:=1 + i
        Range("A5:C5").Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.Copy
        Workbooks.Add
        ActiveSheet.Paste
        Application.CutCopyMode = False
        myfilename = Workbooks("POD1.xlsm").Worksheets("Sheet1").Range("B1")
        ActiveWorkbook.SaveAs Filename:=Path & "\" & myfilename & ".txt", FileFormat:=xlNormal
        i = i + 1
    Loop
    MsgBox "Completed", vbInformation
End Sub
 
Evet kaydediyor ama iki farklı sorun var.

1- 4 ayrı 15.000 satırlık dosya kaydetmesi gerekirken 5-6-7 diye devam ediyor.
2- Kaydedilen txt'lerin formatı desteklenmiyor. Bozuk şekilde kaydediyor
 
1- Workbooks("POD1.xlsm").Worksheets("Sheet1").Range("B1") burada ne yazıyorsa dosya ismi olarak onu kaydeder.
Bu dosyayı paylaşmadığınız için zaten tahmin ederek sorunu çözmeye çalışıyorum. B1 deki değer nasıl değişiyor, neye göre değişiyorsa orayı düzeltin

2-SaveAs satırındaki FileFormat:=xlText yapın
 
dalgalikur' Alıntı:
1- Workbooks("POD1.xlsm").Worksheets("Sheet1").Range("B1") burada ne yazıyorsa dosya ismi olarak onu kaydeder.
Bu dosyayı paylaşmadığınız için zaten tahmin ederek sorunu çözmeye çalışıyorum. B1 deki değer nasıl değişiyor, neye göre değişiyorsa orayı düzeltin

2-SaveAs satırındaki FileFormat:=xlText yapın
Genişletmek için tıkla ...

2-SaveAs satırındaki FileFormat:=xlText yapın - bu tamamdır.

1- Workbooks("POD1.xlsm").Worksheets("Sheet1").Range("B1") burada ne yazıyorsa dosya ismi olarak onu kaydeder.
Bu dosyayı paylaşmadığınız için zaten tahmin ederek sorunu çözmeye çalışıyorum. B1 deki değer nasıl değişiyor, neye göre değişiyorsa orayı düzeltin

Bir önceki cevabım hariç hepsinde söylediklerinizi uygulayıp dosya ekleyip döndüm, görmemiş olabilirsiniz. Şuanda tek sorun döngünün durmaması devam etmesi. myfilename = myfilename -1 burada sorun oluşturuyor olabilir mi ?
 

Ekli dosyalar

Kodları farklı bir dosyadan mı çalıştırıyorsunuz yoksa POD1 isimli dosyadan mı?
Bir de filtrelediğiniz E sütunu tamamen boş filtre sonucunda her zaman boş hücreler kalacak ve kopyalanacaktır.
 
dalgalikur' Alıntı:
Kodları farklı bir dosyadan mı çalıştırıyorsunuz yoksa POD1 isimli dosyadan mı?
Bir de filtrelediğiniz E sütunu tamamen boş filtre sonucunda her zaman boş hücreler kalacak ve kopyalanacaktır.
Genişletmek için tıkla ...

Yo hayır hayır POD1 içerisinde.
Önce Macro1 çalıştırıyorum. O yüzden boş görüyor olabilirsiniz. Macro4'ü dosyanın bu hali ile çalıştırdığınızda göreceksiniz, döngü 4. dosyayı kaydedip durması gerekirken, durmuyor devam ediyor.
 

Ekli dosyalar

Şimdi anlaşıldı.
Buyurun.
Kod: 
Sub Macro4()
    Dim Path As String
    Dim myfilename As String
    If Range("B1") = "" Then
        MsgBox "Önce 'Count Rows' butonuna basarak alanları doldurmalısınız."
        Exit Sub
    End If
    Path = "C:\Desktop"
    Set j = Range("B2")
    i = 0
    Do Until i = j
        Range("E:E").AutoFilter Field:=5, Criteria1:=1 + i
        Range(Range("A5:C5"), Range("A5:C5").End(xlDown)).Copy
        Workbooks.Add
        ActiveSheet.Paste
        Application.CutCopyMode = False
        myfilename = 1 + i
        ActiveWorkbook.SaveAs Filename:=Path & "\" & myfilename & ".txt", FileFormat:=xlText
        ActiveWorkbook.Close False
        i = i + 1
    Loop
    MsgBox "Completed", vbInformation
End Sub
 
dalgalikur' Alıntı:
Şimdi anlaşıldı.
Buyurun.
Kod: 
Sub Macro4()
    Dim Path As String
    Dim myfilename As String
    If Range("B1") = "" Then
        MsgBox "Önce 'Count Rows' butonuna basarak alanları doldurmalısınız."
        Exit Sub
    End If
    Path = "C:\Desktop"
    Set j = Range("B2")
    i = 0
    Do Until i = j
        Range("E:E").AutoFilter Field:=5, Criteria1:=1 + i
        Range(Range("A5:C5"), Range("A5:C5").End(xlDown)).Copy
        Workbooks.Add
        ActiveSheet.Paste
        Application.CutCopyMode = False
        myfilename = 1 + i
        ActiveWorkbook.SaveAs Filename:=Path & "\" & myfilename & ".txt", FileFormat:=xlText
        ActiveWorkbook.Close False
        i = i + 1
    Loop
    MsgBox "Completed", vbInformation
End Sub
Genişletmek için tıkla ...

Harika! Tam istediğim gibi, çok teşekkürler
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst