Xin giúp đỡ sửa code xuất file txt từ file Excel (1 người xem)

[dangquoctoan]

E có tìm trên diễn đàn đoạn code xuất ra file txt từ file Excel. Em muốn nhờ ACE giúp em sửa lại code cho phù hợp với vấn đề của em:
- Em muốn tự động chọn vùng để xuất chứ không phải chọn bằng tay nữa ( Chọn vùng từ A5 trở xuống đến , không lấy dòng có giá trị = 0 )
Mong ACE giúp. Thanks

 

[nghiaphuc]

E có tìm trên diễn đàn đoạn code xuất ra file txt từ file Excel. Em muốn nhờ ACE giúp em sửa lại code cho phù hợp với vấn đề của em:
- Em muốn tự động chọn vùng để xuất chứ không phải chọn bằng tay nữa ( Chọn vùng từ A5 trở xuống đến , không lấy dòng có giá trị = 0 )
Mong ACE giúp. Thanks

Sao bạn không đưa cái file .xlsm kia lên mà lại đưa cái file .xlsx này nhỉ?! Ít ra thì trong file .xlsm kia, người khác cũng thấy được đoạn code đã có, từ đó sửa thành cái mới, có phải là dễ dàng hơn không?

 

[nghiaphuc]

Bạn tham khảo code sau, trật thì làm lại vậy:
[GPECODE=vb]Sub XuatFileText()
Dim Cll As Range
Set FS = CreateObject("Scripting.FileSystemObject")
Set a = FS.CreateTextFile(ThisWorkbook.Path & "\KetQua.txt", True, True)
For Each Cll In Sheets("kq").[A5:A65000]
If Cll.Value = 0 Then Exit For
a.writeline Cll
Next
a.Close: Set a = Nothing: Set FS = Nothing
End Sub[/GPECODE]

 

[dangquoctoan]

Sao bạn không đưa cái file .xlsm kia lên mà lại đưa cái file .xlsx này nhỉ?! Ít ra thì trong file .xlsm kia, người khác cũng thấy được đoạn code đã có, từ đó sửa thành cái mới, có phải là dễ dàng hơn không?

Vâng. Em không để ý. ACE giúp em với nhé

 

[nghiaphuc]

Vâng. Em không để ý. ACE giúp em với nhé

Bạn thử đoạn code ở bài trên của tôi xem đã đúng ý chưa, nó được viết khác với đoạn code trong file của bạn, nhưng nếu đúng ý rồi thì không phải sửa đoạn code trong file của bạn nữa.

 

[dangquoctoan]

Cám ơn anh. Em muốn tên của file xuất ra khác nhau và chọn đường dẫn để lưu file đó.

 

[nghiaphuc]

Cám ơn anh. Em muốn tên của file xuất ra khác nhau và chọn đường dẫn để lưu file đó.

Vậy thì cải tiến thêm chút nữa:
[GPECODE=vb]Sub XuatFileText()
Dim Cll As Range, FD As FileDialog, sFileName As String
On Error Resume Next
Set FD = Application.FileDialog(msoFileDialogSaveAs)
With FD
.Title = "Nhap ten file text can luu"
.InitialFileName = ThisWorkbook.Path & "\"
.FilterIndex = 12: .Show
If FD.SelectedItems.Count = 0 Then Exit Sub
sFileName = .SelectedItems.Item(1)
End With
Set FS = CreateObject("Scripting.FileSystemObject")
Set a = FS.CreateTextFile(sFileName, True, True)
For Each Cll In Sheets("kq").[A5:A65000]
If Cll.Value = 0 Then Exit For
a.writeline Cll
Next
a.Close: Set a = Nothing: Set FS = Nothing
End Sub[/GPECODE]

 

[dangquoctoan]

Cám ơn anh. Anh cho em hỏi thêm chút. Như đoạn code em đưa lên thì em lưu file được dưới loại ANSI (FileFormat:=xlText ) còn đoạn code anh làm mặc dù em đã chọn loại text (tab dilmidted ) nhưng khi mở file txt lên nó vẫn là Unicode

 

[siwtom]

Cám ơn anh. Anh cho em hỏi thêm chút. Như đoạn code em đưa lên thì em lưu file được dưới loại ANSI (FileFormat:=xlText ) còn đoạn code anh làm mặc dù em đã chọn loại text (tab dilmidted ) nhưng khi mở file txt lên nó vẫn là Unicode

Bạn sửa thành

Set a = FS.CreateTextFile(sFileName, True, False)

hoặc

Set a = FS.CreateTextFile(sFileName)

Vì True và False ở những vị trí trên là mặc định (default)

 

[hoangdv]

Code như sau:

Sub savetext()


ActiveWorkbook.SaveAs Filename:="C:\Users\Admin\Documents\Book1.txt", _
FileFormat:=xlUnicodeText, CreateBackup:=False
End Sub