Đăng ký học Excel và VBA cùng GPE tháng 11 - TPHCM

Mua sách "VBA trong Excel - Cải thiện và tăng tốc" tái bản

Kết xuất nội dung 1 ô ra file text

Thảo luận trong 'Lập Trình với Excel' bắt đầu bởi MinhKhai, 14 Tháng mười một 2017 lúc 19:16.

  1. MinhKhai

    MinhKhai Giải pháp Ếc-xào

    Kính chào các anh chị
    Em muốn nhờ các anh chị am hiểu về VBA giúp đỡ. Nội dung em đã mô tả trong file đính kèm
    Cụ thể là: Em muốn dùng VBA kết xuất nội dụng của 1 ô ra file .txt với tên file và đường dẫn lưu file được chỉ định sẵn.
    Lưu ý: Em cần các dòng xuống hàng giống như trong ô và không có dấu "" bọc đoạn văn như khi copy thông thường
    Em đã tham khảo tại https://chandoo.org/wp/2015/10/28/save-range-as-text-using-vba/ nhưng không làm được như mong muốn.
    Rất mong được giúp đỡ.
    Trân trọng cảm ơn
     

    Các file đính kèm:

  2. hpkhuong

    hpkhuong Mới tôt nghiệp Mẫu giáo

    Mã:
    Private Sub CommandButton1_Click()
    Dim Path As String, Rng As Range, Cll As Range, Tem, J As Long
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With Sheet1
    Path = .Range("J1").Value & "\" 'ThisWorkbook.Path
    Set Rng = .Range("H4:H101")
    For Each Cll In Rng
    If Cll.Value <> Empty Then
    Tem = Split(Cll.Value, Chr(10))
        Workbooks.Add
        With ActiveWorkbook
            For J = LBound(Tem) To UBound(Tem)
                .Sheets(1).Range("A1").Offset(J).Value = Tem(J)
            Next
            .SaveAs filename:=Path & Format(Now, "yyyymmdd") & "-" & Cll.Offset(, -7).Value & ".txt", FileFormat:=xlUnicodeText
            .Close True
        End With
        Cll.Offset(, 2).Value = "Message Sent " & Format(Now, "dd/mm/yyyy h:mm:ss AM/PM")
        Cll.Offset(, 3).Value = Format(Now, "yyyymmdd") & "-" & Cll.Offset(, -7).Value
    End If
    Next
    End With
    MsgBox "Done!"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    End Sub
    
     
    MinhKhai thích bài này.
  3. MinhKhai

    MinhKhai Giải pháp Ếc-xào

    Tuyệt vời bác ơi. Cảm ơn bác nhiều
    Bác cho hỏi 1 câu nho nhỏ là: Bác làm là chỉ với 1 bấm chuột là ra hết các file, nhưng file này em update hàng ngày, hàng giờ nên muốn mỗi lần bấm chuột chỉ 1 dòng (1 file) tạo ra thôi.
    Nếu bấm 1 lần nó ra tất cả, thì khi update thêm dữ liệu, rồi bấm nút thì nó sẽ lại tạo ra lô file mới bị trùng nội dung.
    Rất mong bác giúp thêm lần nữa.
    Cảm ơn bác nhiều
     
  4. huuthang_bd

    huuthang_bd Thay thái độ đổi cuộc đời

    Code trong module:
    PHP:
    Sub WriteText(Cll As Range)
        
    Dim sFile As String
        sFile 
    Format(Date"yyyymmdd") & "-" Cll.Offset(, -8).Value
        CreateObject
    ("Scripting.FileSystemObject").CreateTextFile([J1] & "\" & sFile & ".txt").Write Replace(Cll.Offset(, -1), ChrW(10), vbNewLine)
        Cll.Offset(, 1).Value = "
    Message Sent " & Format(Now, "dd/mm/yyyy h:mm:ss AM/PM")
        Cll.Offset(, 2).Value = sFile
    End Sub
    Code cho CommandButton1:
    PHP:
    Private Sub CommandButton1_Click()
    WriteText ActiveCell
    End Sub
     
    MinhKhaibefaint thích bài viết này.
  5. MinhKhai

    MinhKhai Giải pháp Ếc-xào

    Chính xác là những điều em muốn. Không biết nói gì hơn là cảm ơn bác.
    Trong 1 file của em có nhiều sheet có cấu trúc giống hệt nhau (như file đính kèm ban đầu). Không biết nếu sử dụng chung code trong modul không thì sửa như nào ạ ?
    Một lần nữa em xin cảm ơn
     
  6. huuthang_bd

    huuthang_bd Thay thái độ đổi cuộc đời

    Cấu trúc giống nhau thì không cần sửa gì đâu bạn.
     
  7. MinhKhai

    MinhKhai Giải pháp Ếc-xào

    Rất cảm ơn bác
     

Chia sẻ trang này