Exceldeki veriler Txt dosyasına Aktarma

[u.L.a.s]

Merhabalar


Aşağıdaki resimde önizlemede görüldüğü gibi. B sütunundan J sütununa kadar verilerim olabiliyor. Her sütun altında veri olması gerekmiyor. Örneğin B2-C2-G2 de var ama diğerleri boş.

Şunu istiyorum

Bu sayfada yandaki gibi bir buton olsa bu butona basınca b den J ye kadar olan sütunlar altındaki verileri ama boş olanları almayacak şekilde alıp C:\dizini altına SwitchListesi.TXT diye bir çıktı oluştursun ve bu txt dosyasına bu ip bilgilerini alt alta sıralasın istiyorum. Yani Txt dosya aşağıdaki göründüğü gibi olmalıdır.

Örnek excel dosyasıda ektedir.

http://s3.dosya.tc/server29/YYrBTq/ipleritxtyeaktar.xlsx.html

Excelde komut çalışınca oluşacak txt dosyasıda aşağıdaki gibi olmalıdır

http://s3.dosya.tc/server29/QMs42W/SwitchListesi.txt.html

 

[Mehmet Şahin]

Merhaba,
modül dosyasına aşağıdaki kodları yapıştırıp bir butonla ilişkilendiriniz.
İyi çalışmalar.

Sub VeriAktar()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
son = sh.[a65536].End(3).Row
  
 Open "C:\SwitchListesi.txt" For Output As #1
          For i = 2 To son
               For j = 2 To 10
                    If sh.Cells(i, j) <> "" Then
                    Print #1, sh.Cells(i, j)
                    End If
              Next j
            Next i
  Close
  MsgBox "Veriniz C:\SwitchListesi.txt dosyasına kaydedilmiştir."
Set sh = Nothing
End Sub

 

[u.L.a.s]

hata veriyor. ben orjinal excel dosyasını göndersem ekleyebilir misiniz acaba

 

[u.L.a.s]

dosya aşağıdaki linktedir. yani karşıma gelen dosya bu halde oluyor.

Aslında o boş görünen hücrelerde formül olduğundan ya 0 verisi var yada #NA verisi var. bu yüzden hata veriyor olabilir mi acaba

http://s3.dosya.tc/server29/c4zt4f/iptxtaktar.rar.html

 

[u.L.a.s]

evet hatayı verdirten #N/A olan hücreler. yani aradaki / işareti hataya sebebiyet veriyor.

 

[u.L.a.s]

Tamam bu sorunuda hücredeki #N/A değerlerini göstermemesi için IFERROR formülünü kullandım artık hücreler #N/A yerine 0 gösteriyor

 

[u.L.a.s]

hocam tek bir sorun kaldı. şimdi ben o #N/A ları kaldırdım. boş satırları ise formülle çektiğimden hücre sıfır değerini veriyordu. o sıfır değerini excel optionslarındanda görünmez hale getirdim. ama butona basıp txt haline getirince o boş hücrelerdeki 0 değerinlerinide sıralıyor. eğer bu boş görünen yani aslında 0 değeri bulunan hücreleri txt ye aktarmazsak onun dışındaki verileri aktarırsak tamam olacak

 

[u.L.a.s]

Boş hücreler Vlookup ile veri çektiğim için 0 değerini yansıtıyor.
Bu 0 değerleride TXT ye aktarılıyor.
Boş olan veya böyle sıfır olan hücreleri TXT ye aktarmasa alt alta ip bilgilerini sıralasın istiyorum

 

[muygun]

Merhaba;
Syn. dentex'in kodlarını;

Sub VeriAktar()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
son = sh.[a65536].End(3).Row

Open "C:\SwitchListesi.txt" For Output As #1
For i = 2 To son
For j = 2 To 10
hücre = sh.Cells(i, j).Text
If hücre <> "" And hücre <> 0 And hücre <> "#YOK" Then
Print #1, sh.Cells(i, j)
End If
Next j
Next i
Close
MsgBox "Veriniz C:\SwitchListesi.txt dosyasına kaydedilmiştir."
Set sh = Nothing
End Sub

Şeklinde revize ederseniz sıfır boş yada #YOK hatasını pas geçmiş olursunuz.

Veya;

Sub aktarr()
Application.ScreenUpdating = False
On Error Resume Next
Sheets("Sheet1").Range("L2:L65536").ClearContents
Set s1 = ThisWorkbook.Worksheets("Sheet1")
s1.Cells(1, "l") = "C:\SwitchListesi.txt"
For i = 2 To s1.Range("A65536").End(xlUp).Row
For k = 2 To 10
hücre = s1.Cells(i, k).Text
If hücre <> "" And hücre <> 0 And hücre <> "#YOK" Then
sonsatir = s1.Range("L65536").End(xlUp).Row + 1
s1.Cells(sonsatir, "l") = s1.Cells(i, k)
End If
Next k
Next i
dosya = s1.Cells(1, "L")
Open dosya For Output As #1
For a = 2 To [L65536].End(3).Row
veri = s1.Cells(a, "L")
Print #1, veri
Next
Close #1
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Şeklinde denerseniz txt dosyasına ne yazdırdığınızı L sütununda görebilirsiniz.

İyi çalışmalar.

 

[u.L.a.s]

Merhaba;
Syn. dentex'in kodlarını;

Sub VeriAktar()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Sheet1")
son = sh.[a65536].End(3).Row

Open "C:\SwitchListesi.txt" For Output As #1
For i = 2 To son
For j = 2 To 10
hücre = sh.Cells(i, j).Text
If hücre <> "" And hücre <> 0 And hücre <> "#YOK" Then
Print #1, sh.Cells(i, j)
End If
Next j
Next i
Close
MsgBox "Veriniz C:\SwitchListesi.txt dosyasına kaydedilmiştir."
Set sh = Nothing
End Sub

Şeklinde revize ederseniz sıfır boş yada #YOK hatasını pas geçmiş olursunuz.

Veya;

Sub aktarr()
Application.ScreenUpdating = False
On Error Resume Next
Sheets("Sheet1").Range("L2:L65536").ClearContents
Set s1 = ThisWorkbook.Worksheets("Sheet1")
s1.Cells(1, "l") = "C:\SwitchListesi.txt"
For i = 2 To s1.Range("A65536").End(xlUp).Row
For k = 2 To 10
hücre = s1.Cells(i, k).Text
If hücre <> "" And hücre <> 0 And hücre <> "#YOK" Then
sonsatir = s1.Range("L65536").End(xlUp).Row + 1
s1.Cells(sonsatir, "l") = s1.Cells(i, k)
End If
Next k
Next i
dosya = s1.Cells(1, "L")
Open dosya For Output As #1
For a = 2 To [L65536].End(3).Row
veri = s1.Cells(a, "L")
Print #1, veri
Next
Close #1
Application.ScreenUpdating = True
MsgBox "İşlem TAMAM.", vbInformation
End Sub

Şeklinde denerseniz txt dosyasına ne yazdırdığınızı L sütununda görebilirsiniz.

İyi çalışmalar.

emeğine bilgine sağlık çok teşekkür ederim