Nhờ viết code xuất dữ liệu ra file .txt

Liên hệ QC
S

soap1234

Thành viên hoạt động
Tham gia
22/10/13
Bài viết
162
Được thích
6
Nhờ anh chị tạo em macro xuất dữ liệu ra file txt em với
em xin chân thành cảm ơn ạ
 

File đính kèm

  • FileSoLieu.xlsm
    10.7 KB · Đọc: 25
  • FileMau_NguyenVanA.txt
    853 bytes · Đọc: 19
Giải pháp
snow25
soap1234 đã viết:
Em xin chân thành cảm ơn anh và diễn đàn đặc biệt hai anh là Maika8008, smow25 đã guip em. em muốn nhờ các anh và diễn đàn chỉnh sửa em code để lưu được nhiều file .TXT theo họ tên

​

Nhấp chuột vào đây để mở rộng...
Thử code.
Mã: 
Sub tach()
    Dim i As Long, lr As Long, arr, fso As Object, Filename As String, MyFile As Object, j As Long
    Set fso = CreateObject("Scripting.FileSystemObject")
    With Sheets("GCNTT17")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A1:AC" & lr).Value
         For i = 2 To UBound(arr)
             Filename = ThisWorkbook.Path & "\KQ\" & arr(i, 16) & ".txt"
             Set MyFile = fso.CreateTextFile(Filename, True, True)
             For j = 1 To UBound(arr, 2)...
Sắp xếp theo thời gian sắp xếp theo bầu chọn
soap1234 đã viết:
em nạp rồi anh à bị lỗi. có cách nào viết code rồi xuất sang .TXT mà không bị lỗi không anh
Nhấp chuột vào đây để mở rộng...
Nếu không dùng bảng mã Unicode mà buộc phải là TCVN3 thì tôi chịu thua. Bạn chờ ai đó biết về việc này trả lời hoặc mở chủ đề mới hỏi riêng về việc đó xem.
 
Upvote 0
Maika8008 đã viết:
Nếu không dùng bảng mã Unicode mà buộc phải là TCVN3 thì tôi chịu thua. Bạn chờ ai đó biết về việc này trả lời hoặc mở chủ đề mới hỏi riêng về việc đó xem.
Nhấp chuột vào đây để mở rộng...
Dạ dù gì em xin cũng chân thành cảm ơn anh ạ. em nghĩ rồi giờ mình chuyển font tren file excel sang .vntime rồi mới xuất anh à. không biết anh có code chuyển UNicos sang tcvn3 trên file excel không anh . nếu có cho em xin với
 
Upvote 0
soap1234 đã viết:
Dạ dù gì em xin cũng chân thành cảm ơn anh ạ. em nghĩ rồi giờ mình chuyển font tren file excel sang .vntime rồi mới xuất anh à. không biết anh có code chuyển UNicos sang tcvn3 trên file excel không anh . nếu có cho em xin với
Nhấp chuột vào đây để mở rộng...
Bạn dùng chức năng chuyển mã Clipboard của bộ gõ Unikey nhé.
 
Upvote 0
Cái của thớt dính ANSI nên ngỏm.
Lưu ở utf-8 là ngon lành. Unicode không liên quan gì cả
 
Upvote 0
soap1234 đã viết:
Dạ dù gì em xin cũng chân thành cảm ơn anh ạ. em nghĩ rồi giờ mình chuyển font tren file excel sang .vntime rồi mới xuất anh à. không biết anh có code chuyển UNicos sang tcvn3 trên file excel không anh . nếu có cho em xin với
Nhấp chuột vào đây để mở rộng...
Chả hiểu bạn muốn gì.

Trong bài #1 bạn có TCVN3

www.giaiphapexcel.com

Nhờ viết code xuất dữ liệu ra file .txt

Em chào chị nhờ chị giúp em viết code xuất dữ liệu từ file excel ra file .txt. Cấu trúc như file TT17_1_9.txt đính kèm ạ. Em xin chân thành cảm ơn
www.giaiphapexcel.com www.giaiphapexcel.com

Bây giờ bạn chuyển hết dữ liệu nguồn về unicode để rồi lại phải đi hỏi:
em nghĩ rồi giờ mình chuyển font tren file excel sang .vntime rồi mới xuất anh à. không biết anh có code chuyển UNicos sang tcvn3 trên file excel không anh
Nhấp chuột vào đây để mở rộng...

Sao kỳ cục vậy? Dữ liệu đầu vào của bạn là TCVN3 hay unicode? Theo như bài cũ nhất mà tôi trích link ở trên thì bạn có TCVN3. Bạn nghe lời khuyên nên chuyển về unicode. Để rồi bây giờ lại xoay xở làm sao chuyển từ unicode về TCVN3? Thế thì cứ để nguyên TCVN3 như ban đầu có phải nhẹ đầu, nhẹ người, nhẹ code, nhẹ máy, ít tốn điện nước không?
 
Upvote 0
batman1 đã viết:
Chả hiểu bạn muốn gì.

Trong bài #1 bạn có TCVN3

www.giaiphapexcel.com

Nhờ viết code xuất dữ liệu ra file .txt

Em chào chị nhờ chị giúp em viết code xuất dữ liệu từ file excel ra file .txt. Cấu trúc như file TT17_1_9.txt đính kèm ạ. Em xin chân thành cảm ơn
www.giaiphapexcel.com www.giaiphapexcel.com

Bây giờ bạn chuyển hết dữ liệu nguồn về unicode để rồi lại phải đi hỏi:


Sao kỳ cục vậy? Dữ liệu đầu vào của bạn là TCVN3 hay unicode? Theo như bài cũ nhất mà tôi trích link ở trên thì bạn có TCVN3. Bạn nghe lời khuyên nên chuyển về unicode. Để rồi bây giờ lại xoay xở làm sao chuyển từ unicode về TCVN3? Thế thì cứ để nguyên TCVN3 như ban đầu có phải nhẹ đầu, nhẹ người, nhẹ code, nhẹ máy, ít tốn điện nước không?Da
Nhấp chuột vào đây để mở rộng...

batman1 đã viết:
Chả hiểu bạn muốn gì.

Trong bài #1 bạn có TCVN3

www.giaiphapexcel.com

Nhờ viết code xuất dữ liệu ra file .txt

Em chào chị nhờ chị giúp em viết code xuất dữ liệu từ file excel ra file .txt. Cấu trúc như file TT17_1_9.txt đính kèm ạ. Em xin chân thành cảm ơn
www.giaiphapexcel.com www.giaiphapexcel.com

Bây giờ bạn chuyển hết dữ liệu nguồn về unicode để rồi lại phải đi hỏi:


Sao kỳ cục vậy? Dữ liệu đầu vào của bạn là TCVN3 hay unicode? Theo như bài cũ nhất mà tôi trích link ở trên thì bạn có TCVN3. Bạn nghe lời khuyên nên chuyển về unicode. Để rồi bây giờ lại xoay xở làm sao chuyển từ unicode về TCVN3? Thế thì cứ để nguyên TCVN3 như ban đầu có phải nhẹ đầu, nhẹ người, nhẹ code, nhẹ máy, ít tốn điện nước không?
Nhấp chuột vào đây để mở rộng...
Hì. Dạ anh à file Dữ liệu có hai mục đích một là xuất file. TXT để đưa vào phần mềm củ chỉ nhận font là .vntime, .vnarial . còn font time new roman, Arial là để xuất báo cáo tài liệu. Nên lằng nhằng anh à. Có gì các anh thông cảm em với
 
Upvote 0
soap1234 đã viết:
Hì. Dạ anh à file Dữ liệu có hai mục đích một là xuất file. TXT để đưa vào phần mềm củ chỉ nhận font là .vntime, .vnarial . còn font time new roman, Arial là để xuất báo cáo tài liệu. Nên lằng nhằng anh à. Có gì các anh thông cảm em với
Nhấp chuột vào đây để mở rộng...
Bạn không phải giải thích lằng nhằng. Trong bài

www.giaiphapexcel.com

Nhờ viết code xuất dữ liệu ra file .txt

Em chào chị nhờ chị giúp em viết code xuất dữ liệu từ file excel ra file .txt. Cấu trúc như file TT17_1_9.txt đính kèm ạ. Em xin chân thành cảm ơn
www.giaiphapexcel.com www.giaiphapexcel.com

rõ ràng bạn có TCVN3. Sau đó do Maika8008 yêu cầu nên trong chủ đề này bạn lại đính kèm tập tin khác với unicode. Vậy tôi có câu hỏi rất rõ ràng. Thực tế thì bạn có dữ liệu gốc là TCVN3 hay unicode?

Nếu bạn có TCVN3 rồi theo yêu cầu bạn convert sang unicode để rồi bạn lại phải xoay xở: "em nghĩ rồi giờ mình chuyển font tren file excel sang .vntime rồi mới xuất anh à. không biết anh có code chuyển UNicos sang tcvn3 trên file excel không anh ", thì ban đầu bạn chuyển từ TCVN3 sang unicode để làm gì?

Dữ liệu gốc là TCVN3 như chủ đề mà tôi cung cấp link hay là unicode như ở chủ đề này? Chỉ có thể là TCVN3 hoặc unicode thôi, nên đừng thử trả lời kiểu "vừa TCVN3 vừa unicode". Nếu gốc là TCVN3 thì đính kèm lại tập tin với TCVN3. Thế thôi, chả phải gải thích gì cả.
 
Upvote 0
batman1 đã viết:
Bạn không phải giải thích lằng nhằng. Trong bài

www.giaiphapexcel.com

Nhờ viết code xuất dữ liệu ra file .txt

Em chào chị nhờ chị giúp em viết code xuất dữ liệu từ file excel ra file .txt. Cấu trúc như file TT17_1_9.txt đính kèm ạ. Em xin chân thành cảm ơn
www.giaiphapexcel.com www.giaiphapexcel.com

rõ ràng bạn có TCVN3. Sau đó do Maika8008 yêu cầu nên trong chủ đề này bạn lại đính kèm tập tin khác với unicode. Vậy tôi có câu hỏi rất rõ ràng. Thực tế thì bạn có dữ liệu gốc là TCVN3 hay unicode?

Nếu bạn có TCVN3 rồi theo yêu cầu bạn convert sang unicode để rồi bạn lại phải xoay xở: "em nghĩ rồi giờ mình chuyển font tren file excel sang .vntime rồi mới xuất anh à. không biết anh có code chuyển UNicos sang tcvn3 trên file excel không anh ", thì ban đầu bạn chuyển từ TCVN3 sang unicode để làm gì?

Dữ liệu gốc là TCVN3 như chủ đề mà tôi cung cấp link hay là unicode như ở chủ đề này? Chỉ có thể là TCVN3 hoặc unicode thôi, nên đừng thử trả lời kiểu "vừa TCVN3 vừa unicode". Nếu gốc là TCVN3 thì đính kèm lại tập tin với TCVN3. Thế thôi, chả phải gải thích gì cả.
Nhấp chuột vào đây để mở rộng...
Dữ liệu file là unicode trong chủ đề này anh à. anh có code nào chỉ giáo em với .
 
Upvote 0
soap1234 đã viết:
Dữ liệu file là unicode trong chủ đề này anh à. anh có code nào chỉ giáo em với .
Nhấp chuột vào đây để mở rộng...
Tôi tưởng dữ liệu gốc đã có rồi, đã được gõ, được nhập rồi. Và nó chỉ có thể là TCVN3 hoặc unicode. Không thể là mấy hôm trước cũng dữ liệu đó nó là TCVN3, hôm nay mở ra nó lại là unicode. Bạn chỉ có thể muốn 2 code, một cho TCVN3 một cho unicode là gốc.

Nếu là TCVN3 như ở "bên kia" thì cứ trích lọc nó ra thôi. Còn nếu là unicode thì phải chuyển lại thành TCVN3. Chả có cách bí mật nào khác.
 
Upvote 0
soap1234 đã viết:
Dạ chuẩn luôn anh à. anh có code nào không anh em loay hoay mãi anh à
Nhấp chuột vào đây để mở rộng...
Thử code này xem có được không.
Mã: 
Sub tach()
    Dim i As Long, lr As Long, arr, fso As Object, Filename As String, MyFile As Object, j As Long
    Set fso = CreateObject("Scripting.FileSystemObject")
    With Sheets("GCNTT17")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A1:AC" & lr).Value
         For i = 2 To UBound(arr)
             Filename = ThisWorkbook.Path & "\KQ\" & arr(i, 16) & ".txt"
             Set MyFile = fso.CreateTextFile(Filename, True, False)
             For j = 1 To UBound(arr, 2)
                If IsUnicode(arr(1, j)) Then
                   arr(1, j) = UnitoTCVN(arr(1, j))
                End If
                If IsUnicode(arr(i, j)) Then
                   arr(i, j) = UnitoTCVN(arr(i, j))
                End If
                 MyFile.WriteLine arr(1, j) & Space(18 - Len(arr(1, j))) & Application.Trim(arr(i, j))
             Next j
               MyFile.Close
         Next i
    End With
 
    Set MyFile = Nothing
    Set fso = Nothing
End Sub
Function UnitoTCVN(vnStr) As String
On Error Resume Next
   Dim sTemp$
   Dim c As String, i As Integer, L As Long, iC As Long
   For i = 1 To Len(vnStr)
      c = Mid(vnStr, i, 1)
      Select Case c
            Case ChrW$(272): c = ChrW$(167)
            Case ChrW$(259): c = ChrW$(168)
            Case ChrW$(226): c = ChrW$(169)
            Case ChrW$(234): c = ChrW$(170)
            Case ChrW$(244): c = ChrW$(171)
            Case ChrW$(417): c = ChrW$(172)
            Case ChrW$(432): c = ChrW$(173)
            Case ChrW$(273): c = ChrW$(174)
            Case ChrW$(224): c = ChrW$(181)
            Case ChrW$(7843): c = ChrW$(182)
            Case ChrW$(227): c = ChrW$(183)
            Case ChrW$(225): c = ChrW$(184)
            Case ChrW$(7841): c = ChrW$(185)
            Case ChrW$(7857): c = ChrW$(187)
            Case ChrW$(7859): c = ChrW$(188)
            Case ChrW$(7861): c = ChrW$(189)
            Case ChrW$(7855): c = ChrW$(190)
            Case ChrW$(7863): c = ChrW$(198)
            Case ChrW$(7847): c = ChrW$(199)
            Case ChrW$(7849): c = ChrW$(200)
            Case ChrW$(7851): c = ChrW$(201)
            Case ChrW$(7845): c = ChrW$(202)
            Case ChrW$(7853): c = ChrW$(203)
            Case ChrW$(232): c = ChrW$(204)
            Case ChrW$(7867): c = ChrW$(206)
            Case ChrW$(7869): c = ChrW$(207)
            Case ChrW$(233): c = ChrW$(208)
            Case ChrW$(7865): c = ChrW$(209)
            Case ChrW$(7873): c = ChrW$(210)
            Case ChrW$(7875): c = ChrW$(211)
            Case ChrW$(7877): c = ChrW$(212)
            Case ChrW$(7871): c = ChrW$(213)
            Case ChrW$(7879): c = ChrW$(214)
            Case ChrW$(236): c = ChrW$(215)
            Case ChrW$(7881): c = ChrW$(216)
            Case ChrW$(297): c = ChrW$(220)
            Case ChrW$(237): c = ChrW$(221)
            Case ChrW$(7883): c = ChrW$(222)
            Case ChrW$(242): c = ChrW$(223)
            Case ChrW$(7887): c = ChrW$(225)
            Case ChrW$(245): c = ChrW$(226)
            Case ChrW$(243): c = ChrW$(227)
            Case ChrW$(7885): c = ChrW$(228)
            Case ChrW$(7891): c = ChrW$(229)
            Case ChrW$(7893): c = ChrW$(230)
            Case ChrW$(7895): c = ChrW$(231)
            Case ChrW$(7889): c = ChrW$(232)
            Case ChrW$(7897): c = ChrW$(233)
            Case ChrW$(7901): c = ChrW$(234)
            Case ChrW$(7903): c = ChrW$(235)
            Case ChrW$(7905): c = ChrW$(236)
            Case ChrW$(7899): c = ChrW$(237)
            Case ChrW$(7907): c = ChrW$(238)
            Case ChrW$(249): c = ChrW$(239)
            Case ChrW$(7911): c = ChrW$(241)
            Case ChrW$(361): c = ChrW$(242)
            Case ChrW$(250): c = ChrW$(243)
            Case ChrW$(7909): c = ChrW$(244)
            Case ChrW$(7915): c = ChrW$(245)
            Case ChrW$(7917): c = ChrW$(246)
            Case ChrW$(7919): c = ChrW$(247)
            Case ChrW$(7913): c = ChrW$(248)
            Case ChrW$(7921): c = ChrW$(249)
            Case ChrW$(7923): c = ChrW$(250)
            Case ChrW$(7927): c = ChrW$(251)
            Case ChrW$(7929): c = ChrW$(252)
            Case ChrW$(253): c = ChrW$(253)
            Case ChrW$(7925): c = ChrW$(254)
            '----------------------------------------
            Case ChrW$(192): c = ChrW$(181)
            Case ChrW$(193): c = ChrW$(184)
            Case ChrW$(195): c = ChrW$(183)
            Case ChrW$(194): c = ChrW$(162)
            Case ChrW$(201): c = ChrW$(208)
            Case ChrW$(200): c = ChrW$(204)
            Case ChrW$(202): c = ChrW$(163)
            Case ChrW$(7878): c = ChrW$(214)
            Case ChrW$(204): c = ChrW$(215)
            Case ChrW$(211): c = ChrW$(227)
            Case ChrW$(210): c = ChrW$(223)
            Case ChrW$(212): c = ChrW$(164)
            Case ChrW$(213): c = ChrW$(226)
            Case ChrW$(218): c = ChrW$(243)
            Case ChrW$(221): c = ChrW$(253)
      End Select
      sTemp = sTemp + c
   Next i
   UnitoTCVN = sTemp
End Function
'Xac dinh co phai la Unicode hay khong (Suu tam)?
Function IsUnicode(StrRange As Variant) As Boolean
   Dim Str As String, i As Long, bLen As Long, Map() As Byte
   Str = StrRange
   If LenB(Str) Then
      Map = Str
      bLen = UBound(Map)
      For i = 1 To bLen Step 2
         If (Map(i) > 0) Then
            IsUnicode = True
            Exit Function
         End If
      Next
   End If
End Function
 
Upvote 0
Khi xuất ra file. TXT vẫn lỗi chữ anh à
em có gán đoạn code sau
snow25 đã viết:
Thử code này xem có được không.
Mã: 
Sub tach()
    Dim i As Long, lr As Long, arr, fso As Object, Filename As String, MyFile As Object, j As Long
    Set fso = CreateObject("Scripting.FileSystemObject")
    With Sheets("GCNTT17")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A1:AC" & lr).Value
         For i = 2 To UBound(arr)
             Filename = ThisWorkbook.Path & "\KQ\" & arr(i, 16) & ".txt"
             Set MyFile = fso.CreateTextFile(Filename, True, False)
             For j = 1 To UBound(arr, 2)
                If IsUnicode(arr(1, j)) Then
                   arr(1, j) = UnitoTCVN(arr(1, j))
                End If
                If IsUnicode(arr(i, j)) Then
                   arr(i, j) = UnitoTCVN(arr(i, j))
                End If
                 MyFile.WriteLine arr(1, j) & Space(18 - Len(arr(1, j))) & Application.Trim(arr(i, j))
             Next j
               MyFile.Close
         Next i
    End With
 
    Set MyFile = Nothing
    Set fso = Nothing
End Sub
Function UnitoTCVN(vnStr) As String
On Error Resume Next
   Dim sTemp$
   Dim c As String, i As Integer, L As Long, iC As Long
   For i = 1 To Len(vnStr)
      c = Mid(vnStr, i, 1)
      Select Case c
            Case ChrW$(272): c = ChrW$(167)
            Case ChrW$(259): c = ChrW$(168)
            Case ChrW$(226): c = ChrW$(169)
            Case ChrW$(234): c = ChrW$(170)
            Case ChrW$(244): c = ChrW$(171)
            Case ChrW$(417): c = ChrW$(172)
            Case ChrW$(432): c = ChrW$(173)
            Case ChrW$(273): c = ChrW$(174)
            Case ChrW$(224): c = ChrW$(181)
            Case ChrW$(7843): c = ChrW$(182)
            Case ChrW$(227): c = ChrW$(183)
            Case ChrW$(225): c = ChrW$(184)
            Case ChrW$(7841): c = ChrW$(185)
            Case ChrW$(7857): c = ChrW$(187)
            Case ChrW$(7859): c = ChrW$(188)
            Case ChrW$(7861): c = ChrW$(189)
            Case ChrW$(7855): c = ChrW$(190)
            Case ChrW$(7863): c = ChrW$(198)
            Case ChrW$(7847): c = ChrW$(199)
            Case ChrW$(7849): c = ChrW$(200)
            Case ChrW$(7851): c = ChrW$(201)
            Case ChrW$(7845): c = ChrW$(202)
            Case ChrW$(7853): c = ChrW$(203)
            Case ChrW$(232): c = ChrW$(204)
            Case ChrW$(7867): c = ChrW$(206)
            Case ChrW$(7869): c = ChrW$(207)
            Case ChrW$(233): c = ChrW$(208)
            Case ChrW$(7865): c = ChrW$(209)
            Case ChrW$(7873): c = ChrW$(210)
            Case ChrW$(7875): c = ChrW$(211)
            Case ChrW$(7877): c = ChrW$(212)
            Case ChrW$(7871): c = ChrW$(213)
            Case ChrW$(7879): c = ChrW$(214)
            Case ChrW$(236): c = ChrW$(215)
            Case ChrW$(7881): c = ChrW$(216)
            Case ChrW$(297): c = ChrW$(220)
            Case ChrW$(237): c = ChrW$(221)
            Case ChrW$(7883): c = ChrW$(222)
            Case ChrW$(242): c = ChrW$(223)
            Case ChrW$(7887): c = ChrW$(225)
            Case ChrW$(245): c = ChrW$(226)
            Case ChrW$(243): c = ChrW$(227)
            Case ChrW$(7885): c = ChrW$(228)
            Case ChrW$(7891): c = ChrW$(229)
            Case ChrW$(7893): c = ChrW$(230)
            Case ChrW$(7895): c = ChrW$(231)
            Case ChrW$(7889): c = ChrW$(232)
            Case ChrW$(7897): c = ChrW$(233)
            Case ChrW$(7901): c = ChrW$(234)
            Case ChrW$(7903): c = ChrW$(235)
            Case ChrW$(7905): c = ChrW$(236)
            Case ChrW$(7899): c = ChrW$(237)
            Case ChrW$(7907): c = ChrW$(238)
            Case ChrW$(249): c = ChrW$(239)
            Case ChrW$(7911): c = ChrW$(241)
            Case ChrW$(361): c = ChrW$(242)
            Case ChrW$(250): c = ChrW$(243)
            Case ChrW$(7909): c = ChrW$(244)
            Case ChrW$(7915): c = ChrW$(245)
            Case ChrW$(7917): c = ChrW$(246)
            Case ChrW$(7919): c = ChrW$(247)
            Case ChrW$(7913): c = ChrW$(248)
            Case ChrW$(7921): c = ChrW$(249)
            Case ChrW$(7923): c = ChrW$(250)
            Case ChrW$(7927): c = ChrW$(251)
            Case ChrW$(7929): c = ChrW$(252)
            Case ChrW$(253): c = ChrW$(253)
            Case ChrW$(7925): c = ChrW$(254)
            '----------------------------------------
            Case ChrW$(192): c = ChrW$(181)
            Case ChrW$(193): c = ChrW$(184)
            Case ChrW$(195): c = ChrW$(183)
            Case ChrW$(194): c = ChrW$(162)
            Case ChrW$(201): c = ChrW$(208)
            Case ChrW$(200): c = ChrW$(204)
            Case ChrW$(202): c = ChrW$(163)
            Case ChrW$(7878): c = ChrW$(214)
            Case ChrW$(204): c = ChrW$(215)
            Case ChrW$(211): c = ChrW$(227)
            Case ChrW$(210): c = ChrW$(223)
            Case ChrW$(212): c = ChrW$(164)
            Case ChrW$(213): c = ChrW$(226)
            Case ChrW$(218): c = ChrW$(243)
            Case ChrW$(221): c = ChrW$(253)
      End Select
      sTemp = sTemp + c
   Next i
   UnitoTCVN = sTemp
End Function
'Xac dinh co phai la Unicode hay khong (Suu tam)?
Function IsUnicode(StrRange As Variant) As Boolean
   Dim Str As String, i As Long, bLen As Long, Map() As Byte
   Str = StrRange
   If LenB(Str) Then
      Map = Str
      bLen = UBound(Map)
      For i = 1 To bLen Step 2
         If (Map(i) > 0) Then
            IsUnicode = True
            Exit Function
         End If
      Next
   End If
End Function
Nhấp chuột vào đây để mở rộng...
Dạ em làm theo anh vẫn lỗi Font khi xuất ra TXTanh à.
snow25 đã viết:
Thử code này xem có được không.
Mã: 
Sub tach()
    Dim i As Long, lr As Long, arr, fso As Object, Filename As String, MyFile As Object, j As Long
    Set fso = CreateObject("Scripting.FileSystemObject")
    With Sheets("GCNTT17")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("A1:AC" & lr).Value
         For i = 2 To UBound(arr)
             Filename = ThisWorkbook.Path & "\KQ\" & arr(i, 16) & ".txt"
             Set MyFile = fso.CreateTextFile(Filename, True, False)
             For j = 1 To UBound(arr, 2)
                If IsUnicode(arr(1, j)) Then
                   arr(1, j) = UnitoTCVN(arr(1, j))
                End If
                If IsUnicode(arr(i, j)) Then
                   arr(i, j) = UnitoTCVN(arr(i, j))
                End If
                 MyFile.WriteLine arr(1, j) & Space(18 - Len(arr(1, j))) & Application.Trim(arr(i, j))
             Next j
               MyFile.Close
         Next i
    End With
 
    Set MyFile = Nothing
    Set fso = Nothing
End Sub
Function UnitoTCVN(vnStr) As String
On Error Resume Next
   Dim sTemp$
   Dim c As String, i As Integer, L As Long, iC As Long
   For i = 1 To Len(vnStr)
      c = Mid(vnStr, i, 1)
      Select Case c
            Case ChrW$(272): c = ChrW$(167)
            Case ChrW$(259): c = ChrW$(168)
            Case ChrW$(226): c = ChrW$(169)
            Case ChrW$(234): c = ChrW$(170)
            Case ChrW$(244): c = ChrW$(171)
            Case ChrW$(417): c = ChrW$(172)
            Case ChrW$(432): c = ChrW$(173)
            Case ChrW$(273): c = ChrW$(174)
            Case ChrW$(224): c = ChrW$(181)
            Case ChrW$(7843): c = ChrW$(182)
            Case ChrW$(227): c = ChrW$(183)
            Case ChrW$(225): c = ChrW$(184)
            Case ChrW$(7841): c = ChrW$(185)
            Case ChrW$(7857): c = ChrW$(187)
            Case ChrW$(7859): c = ChrW$(188)
            Case ChrW$(7861): c = ChrW$(189)
            Case ChrW$(7855): c = ChrW$(190)
            Case ChrW$(7863): c = ChrW$(198)
            Case ChrW$(7847): c = ChrW$(199)
            Case ChrW$(7849): c = ChrW$(200)
            Case ChrW$(7851): c = ChrW$(201)
            Case ChrW$(7845): c = ChrW$(202)
            Case ChrW$(7853): c = ChrW$(203)
            Case ChrW$(232): c = ChrW$(204)
            Case ChrW$(7867): c = ChrW$(206)
            Case ChrW$(7869): c = ChrW$(207)
            Case ChrW$(233): c = ChrW$(208)
            Case ChrW$(7865): c = ChrW$(209)
            Case ChrW$(7873): c = ChrW$(210)
            Case ChrW$(7875): c = ChrW$(211)
            Case ChrW$(7877): c = ChrW$(212)
            Case ChrW$(7871): c = ChrW$(213)
            Case ChrW$(7879): c = ChrW$(214)
            Case ChrW$(236): c = ChrW$(215)
            Case ChrW$(7881): c = ChrW$(216)
            Case ChrW$(297): c = ChrW$(220)
            Case ChrW$(237): c = ChrW$(221)
            Case ChrW$(7883): c = ChrW$(222)
            Case ChrW$(242): c = ChrW$(223)
            Case ChrW$(7887): c = ChrW$(225)
            Case ChrW$(245): c = ChrW$(226)
            Case ChrW$(243): c = ChrW$(227)
            Case ChrW$(7885): c = ChrW$(228)
            Case ChrW$(7891): c = ChrW$(229)
            Case ChrW$(7893): c = ChrW$(230)
            Case ChrW$(7895): c = ChrW$(231)
            Case ChrW$(7889): c = ChrW$(232)
            Case ChrW$(7897): c = ChrW$(233)
            Case ChrW$(7901): c = ChrW$(234)
            Case ChrW$(7903): c = ChrW$(235)
            Case ChrW$(7905): c = ChrW$(236)
            Case ChrW$(7899): c = ChrW$(237)
            Case ChrW$(7907): c = ChrW$(238)
            Case ChrW$(249): c = ChrW$(239)
            Case ChrW$(7911): c = ChrW$(241)
            Case ChrW$(361): c = ChrW$(242)
            Case ChrW$(250): c = ChrW$(243)
            Case ChrW$(7909): c = ChrW$(244)
            Case ChrW$(7915): c = ChrW$(245)
            Case ChrW$(7917): c = ChrW$(246)
            Case ChrW$(7919): c = ChrW$(247)
            Case ChrW$(7913): c = ChrW$(248)
            Case ChrW$(7921): c = ChrW$(249)
            Case ChrW$(7923): c = ChrW$(250)
            Case ChrW$(7927): c = ChrW$(251)
            Case ChrW$(7929): c = ChrW$(252)
            Case ChrW$(253): c = ChrW$(253)
            Case ChrW$(7925): c = ChrW$(254)
            '----------------------------------------
            Case ChrW$(192): c = ChrW$(181)
            Case ChrW$(193): c = ChrW$(184)
            Case ChrW$(195): c = ChrW$(183)
            Case ChrW$(194): c = ChrW$(162)
            Case ChrW$(201): c = ChrW$(208)
            Case ChrW$(200): c = ChrW$(204)
            Case ChrW$(202): c = ChrW$(163)
            Case ChrW$(7878): c = ChrW$(214)
            Case ChrW$(204): c = ChrW$(215)
            Case ChrW$(211): c = ChrW$(227)
            Case ChrW$(210): c = ChrW$(223)
            Case ChrW$(212): c = ChrW$(164)
            Case ChrW$(213): c = ChrW$(226)
            Case ChrW$(218): c = ChrW$(243)
            Case ChrW$(221): c = ChrW$(253)
      End Select
      sTemp = sTemp + c
   Next i
   UnitoTCVN = sTemp
End Function
'Xac dinh co phai la Unicode hay khong (Suu tam)?
Function IsUnicode(StrRange As Variant) As Boolean
   Dim Str As String, i As Long, bLen As Long, Map() As Byte
   Str = StrRange
   If LenB(Str) Then
      Map = Str
      bLen = UBound(Map)
      For i = 1 To bLen Step 2
         If (Map(i) > 0) Then
            IsUnicode = True
            Exit Function
         End If
      Next
   End If
End Function
Nhấp chuột vào đây để mở rộng...
Dạ em làm theo code của anh mà vẫn lỗi Font anh à
em có code tìm trên diễn đàn mà không biết sao cứ báo lỗi anh à
nhờ anh xem giúp em với. em cảm ơn anh nhiều.
 

File đính kèm

  • BaoLoi.rar
    37 KB · Đọc: 4
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

Bebooby
Tách mã sản phẩm trong chuỗi thông tin
Trả lời
0
Đọc
1
Bebooby
Bebooby
Toanke063
  • Question
Xin hỏi code vba chuyển 1 file pdf bất kì thành ảnh
Trả lời
3
Đọc
52
befaint
befaint
T
Xin trợ giúp code về dò tìm dữ liệu
Trả lời
2
Đọc
113
THU UYEN317
T
thlpro
Truy Vấn Công thức từ Sheet này Qua Sheet Khác
Trả lời
8
Đọc
150
thlpro
thlpro
N
  • Question
VBA - copy các sheets unhide và dạng giá trị theo vùng xác định
Trả lời
3
Đọc
102
huhumalu
H
S
Lý do công thức bị mờ tại ô Function
    • Cười
Trả lời
2
Đọc
64
sakurasumo
S
GPE-Trợ Lý
Đăng ký tham dự hội thảo tại Hà Nội: Power Query - Công cụ quản lý dữ liệu
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
5
Đọc
630
GPE-Trợ Lý
GPE-Trợ Lý
N
  • Question
Làm ơn viết giùm mình macro làm tròn giá trị ạ
    • Cười
Trả lời
14
Đọc
122
ptm0412
ptm0412
ongke0711
  • Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
8 9 10
Trả lời
191
Đọc
10K
ongke0711
ongke0711
CNKyNguyen
Giảm dung lượng của file excel
    • Cảm ơn
    • Cười
    • Thích
Trả lời
2
Đọc
235
CNKyNguyen
CNKyNguyen
hunganh.nguyen
Xin giúp code tách dòng tổng thành những dòng chi tiết với giá trị là 1
Trả lời
9
Đọc
407
vostro 1500
vostro 1500
P
Sự cố về hàm SUMIF
Trả lời
8
Đọc
234
yeudoi
yeudoi
OverAC
Thông báo nội dung xấu và bài viết vi phạm nội quy.
19 20 21
Trả lời
416
Đọc
41K
vanle33
vanle33
S
Chuyển định dạng thời gian từ sa/ch sang AM/PM
Trả lời
2
Đọc
74
Silklynk
S
B
Sắp xếp lịch trực
5 6 7
Trả lời
130
Đọc
86K
TTVAN28
TTVAN28
N
Giúp em hàm Aggregate không chạy được trên Google sheet ah
Trả lời
4
Đọc
143
nguyenthieny
N
hoaithanh9480
Nhờ giúp đỡ về kiểm phiếu bầu
Trả lời
4
Đọc
105
hoaithanh9480
hoaithanh9480
B
Nhờ anh/chị giúp em tìm hàm cho công thức tính lương
Trả lời
2
Đọc
138
hoangtuaotrang_hp_vn
H
SA_DQ
Phẩu thuật Nụ cười lần 3 tại Huế.
    • Thích
    • Yêu thích
Trả lời
1
Đọc
101
HUONGHCKT
H
K
  • Question
Sử dụng Power Query để xử lý nhật ký chung nhiều nợ nhiều có
    • Cười
Trả lời
14
Đọc
303
viethung78
V
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom