时间戳

首页 > 解决方案 > 将 Excel 数据导出/写入 CSV 文件时如何保持 Excel 格式？

excel - 将 Excel 数据导出/写入 CSV 文件时如何保持 Excel 格式？

问题描述

以下代码读取 Excel 数据并将数据放置在 CSV 文件中。

创建 CSV 文件后，我的 Excel 工作表上的格式化数据返回到它的预格式化形式。

例如我的数据“mm/dd/yyy”-> 44067。具有前导“0”的整数，例如“01”-> 1。十进制值，例如“3.80”和或“7.00”->“3.8”和“7”。

Sub ExportCSV()
    Dim vArr, x As Long, y As Long
    Dim fNum As Long, fileName As String
    Dim sLine As String, sVal As String

    vArr = Worksheets("ImportFile").UsedRange.Value2

    fNum = FreeFile
    fileName = Environ$("Userprofile") & "\desktop\2225D_DH.txt"
    Open fileName For Output Lock Write As #fNum

    For x = LBound(vArr) + 1 To UBound(vArr)
        sLine = ""
        For y = LBound(vArr, 2) To UBound(vArr, 2)
        
            If IsInArray(y, Array(9, 12, 13, 14, 15, 16)) Then
                sVal = PadLeft(vArr(x, y), FieldLength(y))
            Else
                sVal = PadRight(vArr(x, y), FieldLength(y))
            End If
        
            sLine = sLine & sVal
        Next y
    
        Print #fNum, sLine
    Next x
    Close fNum

    Debug.Print "Saved file " & fileName
    MsgBox ("Your CSV File Is Ready!")
End Sub

Function FieldLength(col As Long) As Long
    Dim i As Long

    Select Case col
    Case 1: i = 9
    Case 2: i = 6
    Case 3: i = 6
    Case 4: i = 1
    Case 5: i = 2
    Case 6: i = 10
    Case 7: i = 4
    Case 8: i = 4
    Case 9: i = 9
    Case 10: i = 9
    Case 11: i = 9
    Case 12: i = 11
    Case 13: i = 11
    Case 14: i = 11
    Case 15: i = 9
    Case 16: i = 11
    Case 17: i = 1
    Case 18: i = 12
    Case 19: i = 6
    Case 20: i = 12
    Case 21: i = 12
    Case 22: i = 6
    Case 23: i = 12
    Case 24: i = 8
    Case 25: i = 12
    Case 26: i = 12
    Case 27: i = 12
    Case 28: i = 12
    Case 29: i = 1
    End Select

    FieldLength = i
End Function

Function PadLeft(str, num As Long) As String
    If Len(str) > num Then
        PadLeft = Left$(str & Space$(num), num)
    Else
        PadLeft = Space$(num - Len(str)) & str
    End If
End Function


Function PadRight(str, num As Long) As String
    PadRight = Left$(str & Space$(num), num)
End Function

Function IsInArray(searchVal, vArr) As Boolean
    Dim val
    For Each val In vArr
        If searchVal = val Then
            IsInArray = True
            Exit Function
        End If
    Next
End Function

标签： excelvbacsv

解决方案

未经测试，但这样的东西应该可以工作。

如上所述，如果您想要单元格的格式化值，则需要使用Textnot 。Value2

Sub ExportCSV()

    Dim fNum As Long, fileName As String
    Dim sLine As String, sVal As String
    Dim rng As Range, r As Long, c As Long, v
    
    Set rng = Worksheets("ImportFile").UsedRange
    
    fNum = FreeFile
    fileName = Environ$("Userprofile") & "\desktop\2225D_DH.txt"
    Open fileName For Output Lock Write As #fNum
    
    For r = 1 To rng.Rows.Count
        sLine = ""
        For c = 1 To rng.Columns.Count
            v = rng.Cells(r, c).Text
            If IsInArray(c, Array(9, 12, 13, 14, 15, 16)) Then
                sVal = PadLeft(v, FieldLength(c))
            Else
                sVal = PadRight(v, FieldLength(c))
            End If
            sLine = sLine & sVal
        Next c
        Print #fNum, sLine
    Next r
    
    Close fNum
    
    Debug.Print "Saved file " & fileName
    MsgBox ("Your file Is Ready!")
End Sub

推荐阅读