将Excel数据导出/写入CSV文件时的正确格式

问题描述

我有以下代码，该代码读取我的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,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

解决方法

未经测试，但是类似的东西应该可以工作。

如上所述，如果要使用单元格的格式化值，则需要使用Text而不是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