在重新打开CSV导致零

我有如下所示的txt文件

在这里输入图像说明

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

在这里输入图像说明

数据导入后,文件如下所示。 我有一个需要将文件保存为csv然后由不同的系统导入。

在这里输入图像描述

问题是重新打开csv文件如下所示。 帐户列中的前导零消失。 我不能添加'帐户列单元格bcoz系统不接受。 可以做些什么来保持在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 

这是MS Excel中的一个不幸的问题。 除了改变格式和使用xls之外,我找不到任何方法。 我从一个可以被任何人编辑的csv文件提供数据到我的桌面应用程序。 不幸的是,尽pipe我尝试了各种各样的东西,但领先的零问题依然存在 我发现的唯一可靠的方法是在数字前面有!!00101,以便它被接受为string。 这对于应用程序来说是可以的(它可以替代!),但是人的可读性因素仍然受到影响。

根据您的应用程序和使用情况,您可能需要使用不同的格式。