vba - 重新打开时 CSV 中的前导零

Question

这个问题已经有答案了:

Excel CSV - Number cell format (16 个回答)

已关闭 10 年前。

我有如下所示的 txt 文件

我正在使用显示的方法在Excel中导入txt文件here 。列帐户已转换为文本。

导入数据后，文件如下所示。我需要将文件另存为 csv然后由不同的系统导入。

问题在于重新打开 csv 文件时，如下所示。帐户列中的前导零消失。我无法添加'在帐户列单元格前面，因为系统不接受。如何在 csv 打开/重新打开时保留前导零？

我正在使用 vba 完成这一切

Sub createcsv()

    Dim fileName As String
    Dim lastrow As Long
    Dim wkb As Workbook

    lastrow = Range("C" & Rows.Count).End(xlUp).Row
    'If lastrow < 6 Then lastrow = 6


    For i = lastrow To 3 Step -1

        If Cells(i, 4).Text = vbNullString Then
            Cells(i, 1).EntireRow.Delete
        ElseIf Trim(Cells(i, 4).Value) = "-" Then
            Cells(i, 1).EntireRow.Delete
        ElseIf Cells(i, 4).Value = 0 Then
            Cells(i, 1).EntireRow.Delete
        ElseIf CDbl(Cells(i, 4).Text) = 0 Then
            Cells(i, 1).EntireRow.Delete
        End If
    Next


    lastrow = Range("C" & Rows.Count).End(xlUp).Row
    'If lastrow < 6 Then lastrow = 6


    retval = InputBox("Please enter journal Id", Default:="G")
    Range("A3:A" & lastrow) = retval

    retval = InputBox("Please enter Date", Default:=Date)
    Range("B3:B" & lastrow) = retval

    retval = InputBox("Please enter description", Default:="Master entry")
    Range("E3:E" & lastrow) = retval


    Dim strVal As String
    strVal = InputBox("Please enter File Name", Default:="Data")

    filePath = CreateFolder(strVal)
    fileName = GetFileName(filePath)

    ThisWorkbook.Sheets("Sheet1").Copy
    Set wkb = ActiveWorkbook
    Set sht = wkb.Sheets("sheet1")

    Application.DisplayAlerts = False
    wkb.SaveAs fileName:=filePath, FileFormat:=xlCSV

    sht.Cells.Clear
    importTxt wkb, filePath, fileName

    sht.Columns("A:A").NumberFormat = "General"
    sht.Columns("B:B").NumberFormat = "M/d/yyyy"
    sht.Columns("D:D").NumberFormat = "0.00"
    sht.Columns("E:E").NumberFormat = "General"


    wkb.SaveAs fileName:=Replace(filePath, ".txt", ".csv"), FileFormat:=xlCSV
    wkb.Close
    Set wkb = Nothing

    Application.DisplayAlerts = True
err_rout:
    Application.EnableEvents = True
End Sub



Function CreateFolder(Optional strName As String = "Data") As String

    Dim fso As Object, MyFolder As String
    Set fso = CreateObject("Scripting.FileSystemObject")

    MyFolder = ThisWorkbook.Path & "\Reports"


    If fso.FolderExists(MyFolder) = False Then
        fso.CreateFolder (MyFolder)
    End If

    MyFolder = MyFolder & "\" & Format(Now(), "MMM_YYYY")

    If fso.FolderExists(MyFolder) = False Then
        fso.CreateFolder (MyFolder)
    End If

    CreateFolder = MyFolder & "\" & strName & Format(Now(), "DD-MM-YY hh.mm.ss") & ".txt"
    Set fso = Nothing

End Function

Sub importTxt(ByRef wkb As Workbook, ByVal txtLink As String, ByVal fileName As String)

    With wkb.Sheets(fileName).QueryTables.Add(Connection:= _
                                              "TEXT;" & txtLink, _
                                              Destination:=Range("$A$2"))
        .Name = fileName
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 2, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Function GetFileName(ByVal fullName As String, Optional pathSeparator As String = "\") As String
'?sheet1.GetFileName( "C:\Users\Santosh\Desktop\ssss.xlsx","\")

    Dim i As Integer
    Dim tempStr As String
    Dim iFNLenght As Integer
    iFNLenght = Len(fullName)

    For i = iFNLenght To 1 Step -1
        If Mid(fullName, i, 1) = pathSeparator Then Exit For
    Next

    tempStr = Right(fullName, iFNLenght - i)
    GetFileName = Left(tempStr, Len(tempStr) - 4)

End Function

Answer 1

这是 MS Excel 中的一个不幸问题。除了更改格式并使用 xls 之外，我找不到任何解决方法。我从任何人都可以编辑的 csv 文件向我的桌面应用程序提供数据。不幸的是，尽管我尝试了各种方法，前导零问题仍然存在。我发现的唯一可靠的方法是在数字 !00101 之前添加 !，以便将其作为字符串接受。这对于应用程序来说没问题(它可以用任何东西替换 !)，但人类可读性因素仍然受到影响。

根据您的应用程序和用途，您可能必须使用不同的格式。