import csv file(逗号分隔)将其另存为csvfilename

时间:2014-05-14 15:03:58

标签: excel excel-vba csv vba

该子程序应该将CSV文件中的数据(以逗号分隔)粘贴到工作表1中的excelfile中。而在工作表2中,有一些公式,例如= if(sheet1a1< 200; sheet1a1; 0) 1500的数组 然后有一些sumif函数来选择和求和表2中的数据。

此Sub应该循环遍历同一文件夹中的所有csv文件,并按升序将exlfile命名为csvfile。例如m51到m54。它确实循环遍历所有这些,但保存的文件有一个空的表1,我想要所有te csv数据。表2中的所有公式仍然存在。

我无法弄清楚为什么表1仍然是空的。我尝试的最后一件事是将其保存为xls。仍然无法正常工作

之后 在1个mastersheet中 我将所有xlsx文件放在1个文件夹中,并使用morefunc加载项收集所有求和的数字

Sub CSVimporterennaarxlsx()
    'On Error Resume Next
    'declare variable
    'Application.ScreenUpdating = False
    Dim strpath As String
    Dim fmn As Integer
    Dim lmn As Integer
    Dim csvname As String
    Dim strpathcsvname As String
    'active workbook pathway
    strpath = Application.ThisWorkbook.Path
    'ask user for first and last number
    fmn = InputBox("first mouse number")
    lmn = InputBox("last mouse number")
    'einde sub if inputbox is empty
'    If fmn = "" Then
'    MsgBox "No first mouse number"
'    Exit Sub
'    End If
'    If lmn = "" Then
'    MsgBox "No Last mouse number"
'    Exit Sub
'    End If
'    assign variables
    'loop all the files
     For fmn = fmn To lmn
     csvname = "m" & fmn
     strpathcsvname = strpath & "\" & csvname & ".csv"

     'input of csv file
'        ActiveSheet.Cells.Delete
  With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" + strpathcsvname, _
        Destination:=Range("A1"))
'filename without extension
            .Name = csvname
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = false
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileDecimalSeparator = "."
            .TextFileThousandsSeparator = ","
            .TextFileTrailingMinusNumbers = True
        End With
    Call CsvToXlsx(ByVal csvname, strpath)
    Next fmn
Application.DisplayAlerts = True
    End Sub

    Sub CsvToXlsx(ByVal csvname, strpath)
    ChDir (strpath & "/verwerkt")
     Application.DisplayAlerts = False
    csvname = csvname & ".xlsx"
      ActiveWorkbook.SaveAs Filename:=csvname, FileFormat:=51

    End Sub

0 个答案:

没有答案
相关问题