Hướng dẫn chia file excel thành nhiều file txt

[shenwoo]

Chào các bạn, các bạn cho mình hỏi về vấn đề mình có 1 file excel gồm 10.000 dòng và chỉ 1 cột duy nhất, mình muốn chuyển file đó thành 100 file txt mỗi file gồm có 100 dòng theo thứ tự file txt thứ nhất là từ dòng 1 đến 100, file txt thứ 2 từ 101 đến 200 thì phải làm thế nào ạ ? Xin cám ơn

 

[ndu96081631]

Chào các bạn, các bạn cho mình hỏi về vấn đề mình có 1 file excel gồm 10.000 dòng và chỉ 1 cột duy nhất, mình muốn chuyển file đó thành 100 file txt mỗi file gồm có 100 dòng theo thứ tự file txt thứ nhất là từ dòng 1 đến 100, file txt thứ 2 từ 101 đến 200 thì phải làm thế nào ạ ? Xin cám ơn

Đưa file 10000 dòng của bạn lên đây để thí nghiệm chứ

 

[shenwoo]

Đưa file 10000 dòng của bạn lên đây để thí nghiệm chứ

File

Dạ đây ạ, các bạn xem giúp mình thế nào.

 

[Quang_Hải]

File

Dạ đây ạ, các bạn xem giúp mình thế nào.

Thử code này coi sao nha

Sub TachFile_Text()
Dim nguon(), i, k, j, path
path = ThisWorkbook.path
nguon = Range([A1], [A65536].End(3)).Value
   For i = 1 To UBound(nguon) Step 100
      k = k + 1
      Open path & "\NewFile" & k & ".txt" For Output As #1
      For j = i To i + 99
         Print #1, nguon(j, 1)
         If j = UBound(nguon) Then Exit For
      Next
      Close #1
   Next
End Sub

 

[ndu96081631]

File

Dạ đây ạ, các bạn xem giúp mình thế nào.

Viết cho bạn tổng quát luôn:
- Có thể Export một cột hoặc nhiều cột
- Hổ trợ tiếng Việt Unicode luôn

Private Sub Data2txtFile(ByVal Range2Export As Range, ByVal txtFile As String)
  Dim aSource, tmp(), arr(), lR As Long, lC As Long
  On Error GoTo ExitSub
  aSource = Range2Export.Value
  If UCase(Right(txtFile, 4)) <> ".TXT" Then txtFile = txtFile & ".txt"
  ReDim tmp(1 To UBound(aSource, 2))
  ReDim Arr(1 To UBound(aSource, 1))
  With CreateObject("Scripting.FileSystemObject")
    With .CreateTextFile(txtFile, True, True)
      For lR = 1 To UBound(aSource, 1)
        For lC = 1 To UBound(aSource, 2)
          tmp(lC) = aSource(lR, lC)
        Next
        Arr(lR) = Join(tmp, vbTab)
      Next
      .Write Join(Arr, vbCrLf)
      .Close
    End With
  End With
ExitSub:
End Sub

và:

Sub Main()
  Dim Data As Range, Range2Export As Range
  Dim lRs As Long, lR As Long, n As Long
  Dim path As String, txtFile As String
  lRs = Rows.Count
  path = ThisWorkbook.path
 [COLOR=#ff0000] Set Data = Sheet1.Range("A1", Sheet1.Range("A" & lRs).End(xlUp))[/COLOR]
  For lR = 1 To Data.Rows.Count Step 100
    n = n + 1
    txtFile = path & "\text_" & Format(n, "000")
    Set Range2Export = Data.Resize(100).Offset(lR - 1)
    Data2txtFile Range2Export, txtFile
  Next
End Sub

Bạn chỉ cần quan tâm đến Sub Main và dòng code màu đỏ là đủ (khai báo vùng dữ liệu cho đúng). Các code còn lại bạn không cần bận tâm

 

[phuongthon94]

Viết cho bạn tổng quát luôn:
- Có thể Export một cột hoặc nhiều cột
- Hổ trợ tiếng Việt Unicode luôn

Private Sub Data2txtFile(ByVal Range2Export As Range, ByVal txtFile As String)
  Dim aSource, tmp(), arr(), lR As Long, lC As Long
  On Error GoTo ExitSub
  aSource = Range2Export.Value
  If UCase(Right(txtFile, 4)) <> ".TXT" Then txtFile = txtFile & ".txt"
  ReDim tmp(1 To UBound(aSource, 2))
  ReDim Arr(1 To UBound(aSource, 1))
  With CreateObject("Scripting.FileSystemObject")
    With .CreateTextFile(txtFile, True, True)
      For lR = 1 To UBound(aSource, 1)
        For lC = 1 To UBound(aSource, 2)
          tmp(lC) = aSource(lR, lC)
        Next
        Arr(lR) = Join(tmp, vbTab)
      Next
      .Write Join(Arr, vbCrLf)
      .Close
    End With
  End With
ExitSub:
End Sub

và:

Sub Main()
  Dim Data As Range, Range2Export As Range
  Dim lRs As Long, lR As Long, n As Long
  Dim path As String, txtFile As String
  lRs = Rows.Count
  path = ThisWorkbook.path
 [COLOR=#ff0000] Set Data = Sheet1.Range("A1", Sheet1.Range("A" & lRs).End(xlUp))[/COLOR]
  For lR = 1 To Data.Rows.Count Step 100
    n = n + 1
    txtFile = path & "\text_" & Format(n, "000")
    Set Range2Export = Data.Resize(100).Offset(lR - 1)
    Data2txtFile Range2Export, txtFile
  Next
End Sub

Bạn chỉ cần quan tâm đến Sub Main và dòng code màu đỏ là đủ (khai báo vùng dữ liệu cho đúng). Các code còn lại bạn không cần bận tâm

muốn 1 dong 1 file thì sửa chỗ nào bác

 

[BuiQuangThuan]

muốn 1 dong 1 file thì sửa chỗ nào bác

Chắc bỏ chỗ step 100 đi là 1 dòng 1