将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

相反使用，使用下面的代码

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