Vba 将Excel数据保存到.dat文件中，包括非英语单词

下面的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

子保存\u单击（）
将文件名设置为字符串
将工作作为工作表
Set wks=ThisWorkbook.Sheets（1）
变暗行范围作为范围
暗淡的颜色范围
暗淡如长
最后一排一样长
作为整数的Dim ColCounter
将行计数器设置为整数
作为整数的Dim图元行
将行设置为整数
Dim NoofMeta列为整数
作为整数的Dim j
FileName=Application.GetSaveAsFilename
打开文件名，输出为#1
LastRow=wks.Cells（wks.Rows.Count，“A”）.End（xlUp）.Row
设置rowRange=wks.Range（“A1:A”和LastRow）
'循环通过每一行
行计数器=0
metarow=0
合并行=0
noofmetacolumns=0
对于行范围中的每个箭头
'查找当前行中的最后一列
metarow=0
合并行=0
行计数器=行计数器+1
LastCol=wks.Cells（行计数器，wks.Columns.Count）.End（xlToLeft）.Column
设置colRange=wks.Range（wks.Cells（rowCounter，1），wks.Cells（rowCounter，LastCol））
'循环通过行中的所有单元格直到最后一列
ColCounter=0
对于colRange中的每个单元格
“对每个细胞做点什么
'Debug.Print（cell.Value）
如果计数器为0，则
打印#1，“|”；
打印#1，单元格.Value；
其他的
打印#1，单元格.Value；
如果结束
ColCounter=ColCounter+1
如果ColCounter=1，则
如果cell.Value=“METADATA”，则
metarow=1
如果结束
如果cell.Value=“MERGE”，则
合并行=1
如果结束
如果结束
下一个细胞
如果metarow=1，则
noofmetacolumns=ColCounter
如果结束
如果mergerow=1，则
对于j=ColCounter+1到noofmetacolumns
打印#1，“|”；
下一个j
如果结束
打印#1，vbNewLine；
下一个箭头
关闭#1
MsgBox（“成功保存文件”）
端接头
子导入文件（）
作为字符串的Dim Filt
将标题设置为字符串
将文件名设置为字符串
Filt=“HDL Dat文件（*.Dat），*.Dat”
Title=“选择要导入的HDL Dat文件”
FileName=Application.GetOpenFilename（FileFilter:=Filt，Title:=Title）
|定义为分隔符，
，并将数据插入“表1”。
copyDataFromHDLDatFileToSheet文件名“|”和“Sheet1”
第（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 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

使用以下代码代替使用Drange

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 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 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

---

适用于英语单词，但不适用于非英语单词-你的意思是什么？你应该更具体，提供更多关于你的问题的细节。你正在写一个文本文件。你可能想看到非英语的意思，如阿拉伯语或汉语..编写了此代码，用于将excel工作表数据转换为.dat文件fomat..如果效果不好，请改为“utf-8”，改为“unicode”。Hello@Dy.Lee你的解决方案对我很有帮助，但你能帮我解决一个问题吗“即使在行值结束后，它仍在放置”|“什么是不需要的？你能帮我吗？谢谢你advance@maheshgujar：我添加了一些代码。你的情况是因为Usedrange的信息不准确。它再次对大数据做了同样的处理，添加了额外的“|”。@Dy.LeeMERGE | PersonName | PERSON | u NAME | I | 2013/12/07 | | | | | | | | | | | | | | | |像这样