Maika8008
Thành viên gạo cội
- Tham gia
- 12/6/20
- Bài viết
- 4,763
- Được thích
- 5,718
- Donate (Momo)
- Giới tính
- Nam
Thấy nhiều người có nhu cầu lấy dữ liệu từ file dạng text như .txt, .xml,... sang Excel để xử lý tổng hợp, báo cáo, đồng thời cũng xuất dữ liệu từ Excel lưu sang file dạng text, cho nên tôi viết 2 hàm để làm điều ấy.
1. Hàm ấy dữ liệu từ file text vào Excel: Kết quả trả về của hàm là 1 cửa sổ Excel mới chứa dữ liệu lấy được. Có thể gọi hàm từ code VBA để lưu vào mảng hoặc ghi ra sheet, hoặc gõ trực tiếp trên cell của trang tính. Khi gọi hàm trực tiếp trên trang tính thì tại cell chứa công thức sẽ chỉ chuỗi "Xong roi! và sau đó chuyển sang cửa sổ kết quả.
2. Hàm ghi từ Excel sang file text: Kết quả trả về của hàm file text theo định dạng do người chỉ định trong đối số của hàm và lưu cùng đường dẫn với file chứa hàm. Có thể gọi hàm từ code VBA hoặc gõ trực tiếp trên cell của trang tính. Khi gọi hàm trực tiếp trên trang tính thì tại cell chứa công thức sẽ trả về đường dẫn file kết quả.
Tất nhiên khi viết tôi chưa lường hết các nhu cầu người dùng về cách lấy text và cũng không thể tránh khỏi lỗi chạy. Nếu sử dụng có lỗi hoặc nhu cầu gì thêm, các bạn báo lại cho tôi biết để chỉnh sửa.
1. Hàm ấy dữ liệu từ file text vào Excel: Kết quả trả về của hàm là 1 cửa sổ Excel mới chứa dữ liệu lấy được. Có thể gọi hàm từ code VBA để lưu vào mảng hoặc ghi ra sheet, hoặc gõ trực tiếp trên cell của trang tính. Khi gọi hàm trực tiếp trên trang tính thì tại cell chứa công thức sẽ chỉ chuỗi "Xong roi! và sau đó chuyển sang cửa sổ kết quả.
Rich (BB code):
Function GetText_FromFile(ByVal sFullName As String, Optional ByVal OptSeparator = vbTab)
'sFullName - ten file voi duong dan day du
'OptSeparator - Tuy chon dau phan cach du lieu giua cac truong (field) trong 1 dong (record). Mac dinh la vbTab
Dim st As Object, ExApp As Object, ExBook As Object
Dim sMyFile$, sText$
Dim aTmp, aLine, aRsl
Dim iLine&, i&, j&, iCol&
On Error GoTo Loi
sMyFile = sFullName
Set st = CreateObject("ADODB.Stream")
With st
.Charset = "utf-8"
.Open
.LoadFromFile (sMyFile)
sText = .ReadText(-1)
If InStr(1, sText, Chr(10)) Then
aTmp = Split(sText, Chr(10))
iLine = UBound(aTmp)
ReDim aRsl(1 To iLine, 1 To 1000)
For i = 0 To iLine - 1
aLine = Split(aTmp(i), OptSeparator)
If UBound(aLine) > iCol Then iCol = UBound(aLine)
For j = 0 To UBound(aLine)
aRsl(i + 1, j + 1) = aLine(j)
Next
Next i
If UBound(aRsl) > 0 And iCol = 0 Then iCol = 1
ReDim Preserve aRsl(1 To iLine, 1 To iCol)
Set ExApp = CreateObject("Excel.Application")
Set ExBook = ExApp.Workbooks.Add
ExApp.Visible = True
ExBook.Sheets(1).Range("A1").Resize(UBound(aRsl), UBound(aRsl, 2)).Value = aRsl
GetText_FromFile = "Xong roi!"
ExBook.Activate
Else
GetText_FromFile = sText
End If
.Close
End With
Set st = Nothing
Exit Function
Loi:
Set st = Nothing
MsgBox "Da co loi." & vbNewLine & "Ma loi: " & Err.Number & vbNewLine & Err.Description
End Function2. Hàm ghi từ Excel sang file text: Kết quả trả về của hàm file text theo định dạng do người chỉ định trong đối số của hàm và lưu cùng đường dẫn với file chứa hàm. Có thể gọi hàm từ code VBA hoặc gõ trực tiếp trên cell của trang tính. Khi gọi hàm trực tiếp trên trang tính thì tại cell chứa công thức sẽ trả về đường dẫn file kết quả.
Mã:
Function WriteText_ToExistsFile(ByVal MyRange As Range, ByVal SFile As String, _
Optional ByVal dExt As String = ".txt", _
Optional ByVal OptJoin As Boolean = True)
'MyRange - Vung du lieu can ghi vao file text
'sFile - File nguon .txt (hoac co the laf 1 file dang text bat ky: sql, bat, css,...)
'dExt - Phan mo rong cua file muon luu lai: Mac dinh la ".txt", giong file nguon. Muon luu dang khac thi ghi ro ".sql", ".bat", ...
'OptJoin - Tuy chon noi du lieu file nguon voi du lieu moi (True: noi du lieu cu, False: ghi moi, xoa du lieu cu)
Dim st As Object, aData
Dim i&, j&, iDot&, iSCells
Dim sMyFile$, sFileSaveAs$, sWrite$
On Error GoTo Loi
sMyFile = ThisWorkbook.Path & "\" & SFile 'File nguon
iDot = InStr(1, dExt, ".")
If iDot = 0 Then
sFileSaveAs = ThisWorkbook.Path & "\" & Left(SFile, InStr(1, SFile, ".")) & dExt
Else
sFileSaveAs = ThisWorkbook.Path & "\" & Left(SFile, InStr(1, SFile, ".") - 1) & dExt
End If
aData = MyRange.Value 'Du lieu muon ghi vao file text
iSCells = MyRange.Cells.Count
Set st = CreateObject("ADODB.Stream")
With st
.Type = 2
.Charset = "utf-8"
.Open
If OptJoin = True Then
.LoadFromFile (sMyFile) 'Mo file
.ReadText -1 'Doc file
End If
If iSCells = 1 Then
.WriteText aData & Chr(10)
Else
For i = 1 To UBound(aData, 1)
For j = 1 To UBound(aData, 2)
sWrite = sWrite & IIf(aData(i, j) = "", "NULL", aData(i, j)) & vbTab
Next
.WriteText sWrite & Chr(10): sWrite = ""
Next
End If
On Error Resume Next
.SaveToFile sFileSaveAs, 2 'Luu file
.Close
End With
Set st = Nothing
WriteText_ToExistsFile = "Da luu file tai " & sFileSaveAs
Exit Function
Loi:
Set st = Nothing
MsgBox "Da co loi." & vbNewLine & "Ma loi: " & Err.Number & vbNewLine & Err.Description
End FunctionTất nhiên khi viết tôi chưa lường hết các nhu cầu người dùng về cách lấy text và cũng không thể tránh khỏi lỗi chạy. Nếu sử dụng có lỗi hoặc nhu cầu gì thêm, các bạn báo lại cho tôi biết để chỉnh sửa.
. Và giờ mới biết nó là tiếng Nhật Bổn, hèn chi chọn mã Chinese trong Notepad++ nó không giống.
