我有txt文件,如下所示
我正在使用显示here的方法在excel中导入txt文件。列帐户转换为文本。
导入数据后,文件如下所示。
我要求将文件保存为csv
,然后由不同的系统导入。
问题是重新打开csv文件如下所示。帐户列中的前导零消失。我无法在系统不接受的帐户列单元格bcoz前面添加'
。可以做些什么来保持csv open / reopen上的前导零?
我这样做都是使用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
答案 0 :(得分:2)
这是MS Excel中的一个不幸的问题。除了更改格式和使用xls之外,我找不到任何方法。我从csv文件向我的桌面应用程序提供数据,任何人都可以编辑。不幸的是,尽管我尝试了各种各样的东我找到的唯一可靠的方法是在数字!00101之前有一个!以便它被接受为字符串。这对于应用程序来说是可以的(它可以取代!没有任何东西),但仍然会影响人类的可读性因素。
根据您的应用和使用情况,您可能必须使用其他格式。