[µo°Ý] Ãö©óVBA±NEXCEL¤À­¶¥t¦s¬°¤å¦rÀɪº°ÝÃD

suchblue

¥Øªº¬O±NEXCEL¤À­¶ªº¨C¤@­¶³£¥t¦s¬°¤@­Ó¤å¦rÀÉ
¦ý¥u­n¤å¦r¤º®e¦³¥b§Î³r¸¹
«h¸ÓÄ椺®e«e«á·|³Q¥[¤W""

¨Ò¦pEXCEL¤º®e¬°¡G
ABC
ABC,
ABC,}
¥t¦s¬°¤å¦rÀɫ᤺®eÅܦ¨
ABC
"ABC,"
"ABC,}"

½Ð°Ý¦U¦ì¤j¤j¡A¬O§_¦³¤è¦¡¥i¥H¥t¦s¬°¤å¦rÀɤ§«á¡AÁÙ¯à«O«ù¤º®e¤£ÅÜ©O?
·PÁ¦^µª

1. Dim theName As String
   
2. Dim i As Integer
   
3. 
   
4. Sub SaveSheetsAsTXT()
   
5. On Error GoTo Line1
   
6. For i = 1 To 2
   
7. ThisWorkbook.Sheets(i).Copy
   
8. theName = ThisWorkbook.Sheets(i).Name & ".txt"
   
9. ActiveWorkbook.SaveAs Filename:="D:\" & theName, FileFormat:=xlUnicodeText
   
10. ActiveWindow.Close
    
11. Next i
    
12. Line1:
    
13. End Sub

½Æ»s¥N½X

quickfixer

¦^´_ 1# suchblue


    Sub test()
    Dim arr As String, brr
    For Each brr In sheets("¤u§@ªí1").Range("a1").CurrentRegion.Rows
        arr = arr & Join(Application.Transpose(Application.Transpose(brr)), vbTab) & vbCrLf
    Next
    Open "C:\test.txt" For Output As #1
    Print #1, arr
arr=""
    Close #1
End Sub

­ã´£³¡ªL

FileFormat:=xlUnicodeText  
·QÂରunicode®æ¦¡??

quickfixer

¦^´_ 2# quickfixer

Unicode??

    Sub test()
    Dim arr As String, brr
    For Each brr In Sheets("¤u§@ªí1").Range("a1:z100").Rows
        arr = arr & Join(Application.Transpose(Application.Transpose(brr)), vbTab) & vbCrLf
    Next

    Dim fso As Object, txt As Object
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set txt = fso.CreateTextFile("c:\test.txt", True, Unicode:=True)
    txt.WriteLine arr
    txt.Close
    arr = ""
    Set fso = Nothing
    Set txt = Nothing

End Sub

suchblue

¦^´_ 3# ­ã´£³¡ªL


    ¬Oªº¡A¦]¬°¤§«eª½±µ¥t¦s¤§«á Ác¤¤©Î¬O²¤¤³£·|Åܦ¨¶Ã½X

samwang

¦^´_ 1# suchblue

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, Brr, Crr, FPath, sh%, i&, j%
FPath = ThisWorkbook.Path
For sh = 1 To Sheets.Count
    FN = Sheets(sh).Name
    Open FPath & "\" & FN & ".txt" For Output As #sh
    Arr = Sheets(sh).Range("a1").CurrentRegion
    ReDim Brr(1 To UBound(Arr, 2))
    For i = 1 To UBound(Arr)
        For j = 1 To UBound(Arr, 2)
            Brr(j) = Arr(i, j)
        Next
        Crr = Join(Brr, " ")
        Print #sh, Crr
    Next
    Close #sh
Next
End Sub

suchblue

¦^´_ 4# quickfixer


·PÁ¤j¤j Âন¥\¤F
¦ý¨Ï¥Î«áµo²{ ­ì¨Ó¨t²Î»Ý­nªº¬OUTF-8 ¦Ó¤£¬OUTF-16
½Ð°Ý¸Ó«ç»òÂনUTF-8©O?
·PÁ¦^µª

quickfixer

¦^´_ 7# suchblue


    ÅܶýX¬O²ÁcÂà´«ªº°ÝÃD§a?
°Ñ¦Òhttps://stackoverflow.com/questions/31435662/vba-save-a-file-with-utf-8-without-bom

Sub test()
    Dim arr As String, brr, txtutf8 As Object, txtutf8nobom As Object
   
    For Each brr In Sheets("¤u§@ªí1").Range("a1:e50").Rows '½d³ò
        arr = arr & Join(Application.Transpose(Application.Transpose(brr)), vbTab) & vbCrLf
    Next
    '½d³ò¤£©ú¥Î#2 .CurrentRegion.Rows, ©ÎªÌ§ï¥Î#6 °j°é¶]ªºCrr¨ú¥Narr,¤ñ¸û¤£·|§ì¿ù½d³ò
   
    Set txtutf8 = CreateObject("ADODB.Stream")
    Set txtutf8nobom = CreateObject("ADODB.Stream")
   
    With txtutf8 '¦³bom
    .Charset = "UTF-8" '½s½X
    .Open
    .WriteText arr
    .Position = 0
    .SaveToFile "c:\testutf8.txt", 2 'ÀɦW
    .Type = 2
    .Position = 3
    End With
   
    With txtutf8nobom '¨Sbom
    .Type = 1
    .Open
    txtutf8.copyto txtutf8nobom
    .SaveToFile "c:\testutf8nobom.txt", 2
    End With
    txtutf8.close
    txtutf8nobom.close
    Set txtutf8 = Nothing
    Set txtutf8nobom = Nothing
   
End Sub

suchblue

¦^´_ 8# quickfixer


    ·PÁ¤j¤j¡A°ÝÃD¸Ñ¨M¤F!!