[µo°Ý] EXCEL VBA XLSX TO TXT ªÅ¥Õ¦æ

dou10801

½Ð±Ð¦U¦ì«e½ú,xlsxÀÉÂàtxt ¹ï¤è­n¨D³Ì«á­±­n¥[[21]­Ó¥b«¬ªÅ¥Õ(¦pªþ¥óa001.txt),ÁÂÁÂ.[attach]32710[/attach]

Joforn

1. Sub Test001()
   
2.   Dim FileName  As String
   
3.   Dim hFile     As Long
   
4.   Dim lngEndRow As Long
   
5.   Dim R As Long, C As Long
   
6.   Dim bytText() As Byte
   
7.   Dim strText   As String
   
8.   Dim strCrLf   As String
   
9.   
   
10.   R = InStrRev(ThisWorkbook.Name, ".")
    
11.   If R > 0 Then
    
12.     FileName = Left$(ThisWorkbook.Name, R - 1)
    
13.   Else
    
14.     FileName = ThisWorkbook.Name
    
15.   End If
    
16.   strCrLf = Space(21) & vbCrLf
    
17.   With Sheet1
    
18.     lngEndRow = .Range("A" & .Rows.Count).End(xlUp).Row
    
19.     hFile = FreeFile
    
20.     Open ThisWorkbook.Path & Application.PathSeparator & FileName & ".TXT" For Binary As hFile
    
21.     For R = 1 To lngEndRow
    
22.       strText = vbNullString
    
23.       For C = 1 To .UsedRange.Columns.Count
    
24.         strText = strText & .Cells(R, C).Text
    
25.       Next C
    
26.       strText = strText & IIf(Len(strText), strCrLf, vbCrLf)
    
27.       bytText() = StrConv(strText, vbFromUnicode)
    
28.       Put hFile, , bytText()
    
29.     Next R
    
30.     Close hFile
    
31.   End With
    
32. End Sub

½Æ»s¥N½X

dou10801

·PÁÂ...¬ùºÖ®¦¤j¤j«üÂI,°õ¦æ«á¥X²{,¦¹³B»Ý­nª«¥ó.

quickfixer

Sub test002()
    Open ThisWorkbook.Path & "\" & Split(ThisWorkbook.Name, ".")(0) & ".txt" For Output As #1
    For i = 1 To Range("a1").CurrentRegion.Rows.Count
        Print #1, Cells(i, 1) & Cells(i, 2) & Cells(i, 3) & Cells(i, 4) & Cells(i, 5) & Cells(i, 6) & Cells(i, 7) & Cells(i, 8) & String(21, " ")
    Next i
    Close #1
End Sub

Joforn

¦^´_ 3# dou10801
±NWith Sheet1§ï¦¨With ActiveSheet¸Õ¸Õ

dou10801

¦^´_ 5# Joforn ¥i¥H¤F,·P®¦.

dou10801

·PÁ¨â¦ì«e½ú«ü¾É,¦¬¤U½d¥»¾Ç²ß.

n7822123

¦^´_ 7# dou10801

¤W­±¨â¦ì¤j¤j´£¨Ñªºµ{¦¡ ³£»Ý­n¼g¦b§Aªº "A001.xlsx" Àɮפ¤¡A

¦Ò¶q¨ì§A¥i¯à¦³¦h­ÓÀÉ®× Ex A002,A003 ¥i¯à³£»Ý­nÂনtxt¡A

¨C­ÓÀɮ׳£­n½Æ»s¨º¬qµ{¦¡¡A·|¦³ÂI·Ðº¾

§Ú´£¨Ñ¤@¬qµ{¦¡¡AÅý§A¦Û¤v³]©w¨Ó·½¸ô®|&ÀɦW(xlsx) & ¿é¥X¸ô®|&ÀɦW(txt)¡A·|¤ñ¸û¼u©Ê

­Y­n¤@¦¸°õ¦æ¦h­ÓÀɮסA§A¥i¥H¦Û¤v§ï¦¨°j°é

¤W­±¨â¦ì¤j¤j³£¥Î Open»yªk °µ¥X¯Â¤å¦r¤å¥ó¡A§Ú´N´«­Ó¼gªk§a!

¥ÎExcel¥´¶}ÀÉ®×(°ß¿W)¡A¦A¥t¦s¦¨txtÀÉ

³o¬qµ{¦¡¤£­­¨î§A­n©ñ¦b­þ­ÓExcelÀÉ¡A¿é¤J¿é¥X(I/O)³]©w¦n§Y¥i

µ{¦¡¦p¤U


Sub Test1128()
Dim Arr, R&, C&
myPath$ = ThisWorkbook.Path & "\"
xlsPath$ = myPath & "A001.xlsx"   'xlsÀɮרӷ½¸ô®|¡A½Ð¦Û¦æ³]©w(¹w³]¥»µ{¦¡Àɮ׸ô®|¤U)
txtPath$ = myPath & "A001.txt"     '¿é¥Xtxtªº¸ô®|&ÀɦW¡A½Ð¦Û¦æ³]©w(¹w³]¥»µ{¦¡Àɮ׸ô®|¤U)
With Workbooks.Open(xlsPath, , True).Sheets(1)
  Arr = .[A1].CurrentRegion
  For R = 1 To UBound(Arr)
    For C = 2 To UBound(Arr, 2)
      Arr(R, 1) = Arr(R, 1) & Arr(R, C)
    Next C
    Arr(R, 1) = Arr(R, 1) & String(20, " ")
  Next R
  .[A1].Resize(UBound(Arr), UBound(Arr, 2)) = Arr
  .Columns("B").Resize(, UBound(Arr, 2)).Delete
  .SaveAs txtPath, 42
  .Parent.Close True
End With
End Sub

n7822123

¦^´_ 8# n7822123

®¦....21­ÓªÅ¥Õ¦r¤¸¡A¼g¦¨20­Ó¤F¡A³o¸Ì§ï¤@¤U

Arr(R, 1) = Arr(R, 1) & String(21, " ")

dou10801

·PÁ n7822123 ´£¨Ñ¥t¤@ºØ«ä¸ô,­«½Æ¦sÀÉ®É,¨t²Î·|¸ß°Ý,[¬O§_­n¨ú¥N],¦p«ö[§_]·|¤¤Â_,¦p¦ó¸Ñ¨M,·P®¦.