Macro xuất thành file .txt

[winxp83]

Hiện tại mình đã làm xong một bản tính tuy nhiên để xuất một vùng ô có số thành file text thì mình đành potay (nếu làm theo cách tạo file txt rùi cắt dán thì hơi......bình dân wá). Các cao thủ giúp mình với, mình muốn tạo macro giống như in một vùng trên bản tính thành file .txt
Rất mong nhận sự giúp đỡ của mọi người

 

[ndu96081631]

Cám ơn anh,
cho em hỏi thêm đoạn code dưới đây này nếu muốn lưu với (UTF-8, hoặc UNIDCODE) thì phải thêm gì vào. Vì em chỉ lượm trên mạng code thôi nên không hiểu lắm ! chỉ thấy code này chạy được và đúng ý mình cần.

Bạn đưa 1 code ngắn thế biết gì mà test hả bạn? FCTNAME là cái quỷ gì đây?
Tuy nhiên cũng đoán đại
Sửa cái này:
Set newtxt = fso.createtextfile("D:\Filetext.txt")
Thành
Set newtxt = fso.CreateTextFile("D:\Filetext.txt", True, True)
xem sao nhé
--------------
Cuối cùng: Nếu bạn không làm được hãy đưa file Excel lên đây, nói rõ muốn lưu vùng vào vào txt, tôi sẽ thí nghiệm giúp bạn

 

[siwtom]

Lưu với UTF-8 thì phải làm sao nhỉ!?? khó thật đấy

Được mà bạn
Ví dụ code thế này:

Sub Data2txtFile()
  Dim txtFile As String, sArray, tmp(), Arr(), lR As Long, lC As Long
  sArray = Selection.Value
  txtFile = ThisWorkbook.Path & "\tmp.txt"
  ReDim tmp(1 To UBound(sArray, 2))
  ReDim Arr(1 To UBound(sArray, 1))
  With CreateObject("Scripting.FileSystemObject")
    With .CreateTextFile(txtFile, True, True)
      For lR = 1 To UBound(sArray, 1)
        For lC = 1 To UBound(sArray, 2)
          tmp(lC) = sArray(lR, lC)
        Next
        Arr(lR) = Join(tmp, vbTab)
      Next
      .Write Join(Arr, vbCrLf)
      .Close
    End With
  End With
End Sub

Quét chọn vùng dữ liệu trên bảng tính rồi chạy code trên

Nói chính xác thì trong tập tin ta có UTF-16 (16-bit Unicode Transformation Format) chứ không phải là UTF-8 (8-bit)
Muốn có UTF-8 thì phải tự convert sang UTF-8 chứ không có hàm, phương thức nào làm thay cho ta cả.

 

[hoangexcell]

Nói chính xác thì trong tập tin ta có UTF-16 (16-bit Unicode Transformation Format) chứ không phải là UTF-8 (8-bit)
Muốn có UTF-8 thì phải tự convert sang UTF-8 chứ không có hàm, phương thức nào làm thay cho ta cả.

Nếu thế thì thôi rồi ... mà sao không có hàm convert à?!

Cám ơn [h=2]ndu96081631 nhiều, tuy không tạo ra UTF-8 nhưng là Unicode rồi . còn UTF-8 thì thua!![/h]

 

[siwtom]

Nếu thế thì thôi rồi ... mà sao không có hàm convert à?!

Cám ơn ndu96081631 nhiều, tuy không tạo ra UTF-8 nhưng là Unicode rồi . còn UTF-8 thì thua!!

Không phải là không thể viết hàm convert. Nhưng nếu tôi hiểu nhu cầu của bạn thì bạn muốn xuất dữ liệu ra tập tin TXT? Nếu thế thì khi có TXT ở dạng unicode rồi thì mở nó bằng notepad của Windows rồi save as --> chọn UTF-8. Viết convert gì cho mệt xác??????????????????????

 

[hoangexcell]

Không phải là không thể viết hàm convert. Nhưng nếu tôi hiểu nhu cầu của bạn thì bạn muốn xuất dữ liệu ra tập tin TXT? Nếu thế thì khi có TXT ở dạng unicode rồi thì mở nó bằng notepad của Windows rồi save as --> chọn UTF-8. Viết convert gì cho mệt xác??????????????????????

Dạ cách này thì hiểu nhưng vẫn muốn code chạy luôn một lần cho khỏe đó mà.
Nếu viết code mệt hơn thì thui vậy hihi

 

[chaymacro]

Cảm ơn các bác đã hướng dẫn code .em cũng đã làm thử save ra được file .txt rồi .nhưng vấn đề là có 1 số dòng nó lại chèn thêm dấu " " vào đầu và cuối của dòng đó.như dưới đây :

Sub ExcelToTxt()
"Dim MyPath As String, MyFileName As String"
Dim newbook As Workbook
"MyPath = ""D:\"""
"MyFileName = InputBox(""Nhap ten file can luu:"", ""Export from excel to text"")"
Selection.Copy
Set newbook = Workbooks.Add
With newbook
".Sheets(""Sheet1"").Range(""B1:C22"").PasteSpecial xlPasteValues"

Các bác ktra giúp em với ,em không rành VB lắm, cảm ơn bạn nhiều .
Có cánh nào để chuyển về dạng như dưới đây ko ah(giữ nguyên trạng thái o fille excell )?

Sub ExcelToTxt()
Dim MyPath As String, MyFileName As String
Dim newbook As Workbook
MyPath = "D:\"
MyFileName = InputBox("Nhap ten file can luu:", "Export from excel to text")
Selection.Copy
Set newbook = Workbooks.Add
With newbook
.Sheets("Sheet1").Range("B1:C22").PasteSpecial xlPasteValues

 

[ryanhudson]

Bạn xem đoạn code này nhé

Sub ExcelToTxt()
    Dim MyPath As String, MyFileName As String
    Dim newbook As Workbook
    MyPath = "D:\"
    MyFileName = InputBox("Nhap ten file can luu:", "Export from excel to text")
    Selection.Copy
    Set newbook = Workbooks.Add
    With newbook
        .Sheets("Sheet1").Range("A1").PasteSpecial xlPasteValues
        .SaveAs Filename:=MyPath & MyFileName & ".txt", _
                          FileFormat:=xlUnicodeText, CreateBackup:=False
        .Close True
    End With
End Sub

Cần xuất vùng nào thì bạn phải chọn trước (Đánh dấu vùng cần xuất).

a cho em hỏi có cách nào chọn 2 vùng cần xuất (trong 1 sheet) ra 1 file txt được không, tại e ctrl 2 vùng thì nó hiện ra bảng "ko được chọn nhiều vùng 1 lúc"

 

[hoaducvn90]

Đối với đoạn code này, trước khi chạy bạn phải chiếu sáng vùng cần xuất ra file *.txt.
Hoặc nếu bạn đã cố định vùng cần xuất ra file txt luôn là vùng B1:C22 thì sửa lại một tí:

Sub ExcelToTxt()
    Dim MyPath As String, MyFileName As String
    Dim NewBook As Workbook
    MyPath = "D:\"
    MyFileName = InputBox("Nhap ten file can luu:", "Export from excel to text")
    ActiveSheet.[B1:C22].Select     ''Thêm đoạn này vô là xong
    Selection.Copy
    Set NewBook = Workbooks.Add
    With NewBook
        .Sheets("Sheet1").[A1].PasteSpecial xlPasteValues  ''Sửa tí chỗ này nữa
        .SaveAs Filename:=MyPath & MyFileName & ".txt", _
                          FileFormat:=xlUnicodeText, CreateBackup:=False
        .Close True
    End With
End Sub

Lưu ý: khi Paste ra workbook mới thì Paste vào ô đầu tiên của sheet mới trong workbook vừa tạo ra.

Mến Chào Anh Cadafi, Rất cảm ơn chia sẽ của Anh về đoạn code. Em đã ứng dụng được vào Công Việc hiện tại, tuy nhiên còn 1 lỗi nhỏ là: khi xuất thành file txt (unicode), chuỗi có dấu phẩy " , ", bị thêm vào dấu ngoặc kép. Em có tìm hiểu 1 số thông tin là sử dụng Replace dấu " " " thành " ". Nhưng ko biết kết hợp vào đoạn code này thế nào, Rất mong Anh chia sẽ thêm. Cảm ơn nhiều.