ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

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

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

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

TOTXT.rar (8 KB)

§ù¤p¥­

  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
¥@¬É¨º»ò¤j¡A¥i§Ú·Q¥h­þ¡H

TOP

RE: EXCEL VBA XLSX TO TXT ªÅ¥Õ¦æ

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

¦¹³B»Ý­nª«¥ó.jpg (82.9 KB)

¦¹³B»Ý­nª«¥ó.jpg

¦¹³B»Ý­nª«¥ó.jpg (82.9 KB)

¦¹³B»Ý­nª«¥ó.jpg

§ù¤p¥­

TOP

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

TOP

¦^´_ 3# dou10801
±NWith Sheet1§ï¦¨With ActiveSheet¸Õ¸Õ
¥@¬É¨º»ò¤j¡A¥i§Ú·Q¥h­þ¡H

TOP

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

TOP

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

TOP

¥»©«³Ì«á¥Ñ n7822123 ©ó 2020-11-28 18:20 ½s¿è

¦^´_ 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
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

¦^´_ 8# n7822123

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

Arr(R, 1) = Arr(R, 1) & String(21, " ")
µ{¦¡¬O¨Ì»Ý¨D¼gªº¡A»Ý¨Dªí¹F¤£²M·¡
©ÎªÌ¨S¦³¤W¶Çªþ¥ó¡A·R²ö¯à§U

TOP

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

TOP

        ÀR«ä¦Û¦b : ¬Ý§O¤H¤£¶¶²´¡A¬O¦Û¤v­×¾i¤£°÷¡C
ªð¦^¦Cªí ¤W¤@¥DÃD