2013-06-10 4 views
5

Mam txt plik, który wygląda jak poniżejzerem w formacie CSV na wznowienie

enter image description here

ja zaimportowaniu pliku txt w programie Excel za pomocą metody przedstawionej here. Konto w kolumnie jest konwertowane na tekst.

enter image description here

Gdy dane są importowane, plik wygląda jak poniżej. Mam wymóg zapisania pliku jako csv, który jest następnie importowany przez inny system.

enter image description here

Problem polega na ponownym otwarciu pliku CSV wygląda jak poniżej. Początkowe zero w kolumnie konta znika. Nie mogę dodać ' przed komórkami kolumny Konto bcoz system nie akceptuje. Co można zrobić, aby zachować wiodące zero w otwartym/otwartym oknie CSV?

enter image description here ja robię to wszystko przy użyciu 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

@brettdj Dlaczego czujesz jego duplikat? – Santosh

+0

Jakiej wersji programu Excel używasz? W programie Excel 2007 właśnie zaimportowałem plik z kolumną konta jako tekst. Zerowe początki były w porządku, zapisałem je następnie jako CSV i wczytałem CSV do Notatnika, a początkowe zera tam gdzie wciąż są. – Wild138

+0

Korzystam z programu Excel 2010 i zapisuję plik jako CSV i ponownie go otwiera. – Santosh

Odpowiedz

2

To niefortunny błąd w MS Excel. Nie mogłem tego obejść, z wyjątkiem zmiany formatu i użycia xls. Dostarczałem dane do mojej aplikacji komputerowej z pliku csv, który mógł być edytowany przez każdego. Niestety, wiodący problem zerowy trwał pomimo różnych rzeczy, które próbowałem. Jedyną niezawodną metodą, jaką znalazłem, było posiadanie! Przed numerem 00101, tak aby została przyjęta jako ciąg znaków. To było w porządku dla aplikacji (mogło zastąpić! Z niczym), ale nadal wpływał na ludzki współczynnik czytelności.

W zależności od zastosowania i zastosowania może być konieczne użycie innego formatu.