该子程序应该将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