保存Excel數據導入.dat文件，包括非英文單詞

Question

下面的VBA代碼，用於保存Excel數據導入.dat文件，完全適用於英文單詞，但不適合非英語。

你應該怎麼我修改它來處理非英語單詞？

Sub Save_Click() 
    Dim FileName As String 
    Dim wks As Worksheet 
    Set wks = ThisWorkbook.Sheets(1) 
    Dim rowRange As Range 
    Dim colRange As Range 
    Dim LastCol As Long 
    Dim LastRow As Long 
    Dim ColCounter As Integer 
    Dim rowCounter As Integer 
    Dim metarow As Integer 
    Dim mergerow As Integer 
    Dim noofmetacolumns As Integer 
    Dim j As Integer 
    FileName = Application.GetSaveAsFilename 
    Open FileName For Output As #1 
    LastRow = wks.Cells(wks.Rows.Count, "A").End(xlUp).Row 
    Set rowRange = wks.Range("A1:A" & LastRow) 
    'Loop through each row 
    rowCounter = 0 
    metarow = 0 
    mergerow = 0 
    noofmetacolumns = 0 
    For Each rrow In rowRange 
    'Find Last column in current row 
    metarow = 0 
    mergerow = 0 
    rowCounter = rowCounter + 1 
    LastCol = wks.Cells(rowCounter, wks.Columns.Count).End(xlToLeft).Column 
    Set colRange = wks.Range(wks.Cells(rowCounter, 1), wks.Cells(rowCounter, LastCol)) 
    'Loop through all cells in row up to last col 
     ColCounter = 0 
     For Each cell In colRange 
       'Do something to each cell 
       'Debug.Print (cell.Value) 
       If ColCounter <> 0 Then 
        Print #1, "|"; 
        Print #1, cell.Value; 
       Else 
        Print #1, cell.Value; 
       End If 

       ColCounter = ColCounter + 1 

       If ColCounter = 1 Then 
       If cell.Value = "METADATA" Then 
        metarow = 1 
       End If 

       If cell.Value = "MERGE" Then 
        mergerow = 1 
       End If 
       End If 



      Next cell 
     If metarow = 1 Then 

      noofmetacolumns = ColCounter 

     End If 

     If mergerow = 1 Then 

      For j = ColCounter + 1 To noofmetacolumns 
       Print #1, "|"; 
      Next j 

     End If 


     Print #1, vbNewLine; 
     Next rrow 


     Close #1 


    MsgBox ("File Saved Successfully") 
    End Sub 
    Sub ImportFile() 
    Dim Filt As String 
    Dim Title As String 
    Dim FileName As String 
    Filt = "HDL Dat Files (*.dat),*.dat" 
    Title = "Select a HDL Dat File to Import" 
    FileName = Application.GetOpenFilename(FileFilter:=Filt, Title:=Title) 
    'Procedure call. | is defined as separator, 
    'and data is to be inserted on "Sheet1". 
    copyDataFromHDLDatFileToSheet FileName, "|", "Sheet1" 
    Sheets(1).Select 
End Sub 

Answer 1

測試此代碼。

Sub Save_Click() 
    Dim FileName As String 
    Dim wks As Worksheet 
    Dim rngDB As Range 
    Set wks = ThisWorkbook.Sheets(1) 

    FileName = Application.GetSaveAsFilename 
    Set rngDB = wks.UsedRange 
    TransToCSV FileName, rngDB 

    MsgBox ("File Saved Successfully") 
End Sub 
Sub TransToCSV(myfile As String, rng As Range) 

    Dim vDB, vR() As String, vTxt() 
    Dim i As Long, n As Long, j As Integer 
    Dim objStream 
    Dim strTxt As String 

    Set objStream = CreateObject("ADODB.Stream") 
    vDB = rng 
    For i = 1 To UBound(vDB, 1) 
     n = n + 1 
     ReDim vR(1 To UBound(vDB, 2)) 
     For j = 1 To UBound(vDB, 2) 
      vR(j) = vDB(i, j) 
     Next j 
     ReDim Preserve vTxt(1 To n) 
     vTxt(n) = Join(vR, "|") 
    Next i 
    strTxt = Join(vTxt, vbCrLf) 
    With objStream 
     .Charset = "utf-8" 
     .Open 
     .WriteText strTxt 
     .SaveToFile myfile, 2 
     .Close 
    End With 
    Set objStream = Nothing 

End Sub 

相反Usedrange，使用波紋管代碼

Sub Save_Click() 
    Dim FileName As String 
    Dim wks As Worksheet 
    Dim rngDB As Range 
    Dim r As Long, c As Long 

    Set wks = ThisWorkbook.Sheets(1) 

    With wks 
     r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
     c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 
     Set rngDB = .Range("a1", .Cells(r, c)) 
    End With 

    FileName = Application.GetSaveAsFilename 

    TransToCSV FileName, rngDB 

    MsgBox ("File Saved Successfully") 
End Sub 

我覺得你在你的表有沒有空白單元格。 測試此代碼。

Sub Cellselect() 

    Dim FileName As String 
    Dim wks As Worksheet 
    Dim rngDB As Range 
    Dim r As Long, c As Long 

    Set wks = ThisWorkbook.Sheets(1) 

    With wks 
     r = .Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 
     c = .Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column 
     .Cells(r, c).Select 
    End With 

End Sub