Chuyển dữ liệu trong Excel sang *.txt

[PhanTuHuong]

Dưới đây là thủ tục chuyển dữ liệu của ô A1:A10 (nếu không trống) sang file *.txt (sưu tầm):

Sub MakeTextFile()

'*** change dimension to use late binding ***
Dim FSO As Object       'FSO As Scripting.FileSystemObject
Dim TextStr As Object   'TextStr As Scripting.TextStream

Dim Rng As Range

'*** use create object to create a FileSystemObject ***
Set FSO = CreateObject("Scripting.FileSystemObject")

'*** Open a text file for appending ***
'*** if it does not already exist, then create it ***
ForAppending = 8
Set TextStr = FSO.OpenTextFile(Filename:="C:\MyFile.txt", _
    IOMode:=ForAppending, create:=True)

For Each Rng In Range("A1:A10")
    If Rng.Value <> "" Then
        TextStr.WriteLine Text:="The Value In: " & _
            Rng.Address(False, False) & " is: " & Rng.Value
    End If
Next Rng


TextStr.Close
Set FSO = Nothing


End Sub

 

[ruadangyeu]

Bài viết rất hay, tuy nhiên em có một thắc mắc nhỏ

For Each Rng In Range("A1:A10")
If Rng.Value <> "" Then
TextStr.WriteLine Text:="The Value In: " & _
Rng.Address(False, False) & " is: " & Rng.Value
End If
Next Rng

Sao chúng ta không ghi cả công thức trong các ô nữa bác nhỉ
Làm như vậy có thể sẽ có lơi hơn khi chúng ta đọc ngược dữ liệu lại file excel.

Bác Huong thấy có hợp lý không, nếu có bác có thể sửa lại code cho anh em học hỏi đôi chút không?

From Jenni
Hì, SG xì pam chút xíu. Bác Hướng chứ hổng phải Bác Huong.

 

[PMXD]

Dưới đây là thủ tục chuyển dữ liệu của ô A1:A10 (nếu không trống) sang file *.txt (sưu tầm):

Sub MakeTextFile()

'*** change dimension to use late binding ***
Dim FSO As Object       'FSO As Scripting.FileSystemObject
Dim TextStr As Object   'TextStr As Scripting.TextStream

Dim Rng As Range

'*** use create object to create a FileSystemObject ***
Set FSO = CreateObject("Scripting.FileSystemObject")

'*** Open a text file for appending ***
'*** if it does not already exist, then create it ***
ForAppending = 8
Set TextStr = FSO.OpenTextFile(Filename:="C:\MyFile.txt", _
    IOMode:=ForAppending, create:=True)

For Each Rng In Range("A1:A10")
    If Rng.Value <> "" Then
        TextStr.WriteLine Text:="The Value In: " & _
            Rng.Address(False, False) & " is: " & Rng.Value
    End If
Next Rng


TextStr.Close
Set FSO = Nothing


End Sub

Anh Hướng ơi, hình như dùng đối tượng FSO (File System Object) thì anh phải cài VB6 vào máy và phải Reference vào VBA đấy. Sao anh không hướng dẫn mọi người cách ghi file txt bằng các hàm sẵn có : Open .... For OutPut, Print.... cho đơn giản.

 

[dnphuonganh]

Em nhờ các anh giúp đỡ vấn đề sau:
Em dùng code trên và thay địa chỉ A1:A10 bằng vùng có tên là vung1.
Trong bảng tính của em có các name vung1, vung2,...vung10.
Vậy cần sửa code trên như thế nào để không phải lặp lại đoạn

For Each Rng In Range("vung1")
    If Rng.Value <> "" Then
        TextStr.WriteLine Text:="The Value In: " & _
            Rng.Address(False, False) & " is: " & Rng.Value
    End If
Next Rng
For Each Rng In Range("vung2")
    If Rng.Value <> "" Then
        TextStr.WriteLine Text:="The Value In: " & _
            Rng.Address(False, False) & " is: " & Rng.Value
    End If
Next Rng

Cảm ơn các anh!

 

[cadafi]

Em nhờ các anh giúp đỡ vấn đề sau:
Em dùng code trên và thay địa chỉ A1:A10 bằng vùng có tên là vung1.
Trong bảng tính của em có các name vung1, vung2,...vung10.
Vậy cần sửa code trên như thế nào để không phải lặp lại đoạn

Bạn sửa đoạn code này như sau:

Dim MaxVung as long, Zi as Long
MaxVung = 10      ''Nếu có 12,13,....n vùng thì sửa tại đây
For Zi = 1 to MaxVung
   For Each Rng In Range("vung" & Zi)
      If Rng.Value <> "" Then
           TextStr.WriteLine Text:="The Value In: " & _
            Rng.Address(False, False) & " is: " & Rng.Value
      End If
   Next Rng
Next Zi

 

[macminhhung]

Cho mình hỏi chút, mình không muốn chuyển dưới dạng line, mà trong quá trình chuyển từ Excel sang text vẫn phải giữ nguyên vị trí dữ liệu thì phải làm thế nào?

Nhờ các cao thủ chỉ giúp. Đang rất cần

Cảm ơn!