我们使用Revit文件中的Python创建CSV文件。我尝试使用VBA代码将CSV导入Excel。
projectinfo(data_fill = 8)正常运行。 然后我在Excel中导入了其他7个CSV。但是发生的事情是我的墙(wanden_data / data_fill = 1)en floor(vloeren_data / data_fill = 2)CSV首先在列A之前插入列,其他CSV从单元格A5中复制OK ...
有人可以解释会发生什么吗?我能做些什么呢?所有7个CSV都使用相同的代码...
Sub CSV_inladen()
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
Dim File As String
Dim teller As Integer
teller = 0
Dim Missers As String
Missers = ""
' csv in array
Dim CSV(1 To 8) As String
' csv bestanden vastleggen
CSV(1) = "wanden_data"
CSV(2) = "vloeren_data"
CSV(3) = "plafonds_data"
CSV(4) = "liggers_data"
CSV(5) = "kolommen_data"
CSV(6) = "daken_data"
CSV(7) = "overige_data"
CSV(8) = "projectinfo_data"
' Loopje voor het tellen en controleren
For c = 1 To UBound(CSV)
File = ThisWorkbook.Path & "\csv_bestanden\" & CSV(c) & "*.csv"
Filename = Dir(File)
If Filename <> "" Then
teller = teller + 1
Else
Missers = Missers & Chr(13) & " - " & CSV(c) & ".csv"
End If
Next c
' controle of CSV bestanden bestaan
If teller = 0 Then
MsgBox "Geen CSV-bestanden gevonden. Zorg dat deze op de juiste manier aangemaakt worden.", vbCritical + vbOKOnly, "Geen data"
ElseIf teller < UBound(CSV) Then
MsgBox "Onvoldoende CSV-bestanden gevonden. Zorg dat deze op de juiste manier aangemaakt worden. De volgende CSV bestanden ontbreken:" & Missers, vbCritical + vbOKOnly, "Geen data"
Else
' werkbladen in array
Dim Sh(1 To 8) As String
' werkbladen vastleggen
Sh(1) = "wanden_meetstaat"
Sh(2) = "vloeren_meetstaat"
Sh(3) = "plafonds_meetstaat"
Sh(4) = "liggers_meetstaat"
Sh(5) = "kolommen_meetstaat"
Sh(6) = "daken_meetstaat"
Sh(7) = "overige_categorien"
Sh(8) = "meetstaat_instructie"
For data_fill = 1 To UBound(Sh)
' werkblad en csv-bestand bepalen
Set WS = ActiveWorkbook.Sheets(Sh(data_fill))
csvFile = ThisWorkbook.Path & "\csv_bestanden\" & CSV(data_fill) & ".csv"
' excel vullen uit csv
If data_fill = 8 Then
With WS.QueryTables.Add(Connection:="TEXT;" & csvFile, Destination:=WS.Range("F2"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
Else
With WS.QueryTables.Add(Connection:="TEXT;" & csvFile, Destination:=WS.Range("A5"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
'.RefreshStyle = xlOverwriteCells
.SavePassword = False
.SaveData = False
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 850
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End If
' querytables verwijderen
On Error GoTo nothingtodelete
Sheets(Sh(data_fill)).QueryTables(1).SaveData = False
Sheets(Sh(data_fill)).QueryTables.Item(1).Delete
nothingtodelete:
Next data_fill
' melding met verwerkte tijd
SecondsElapsed = Round(Timer - StartTime, 2)
MsgBox "Data toegevoegd in " & SecondsElapsed & " seconden", vbOKOnly + vbInformation, "Data toegevoegd"
End If
End Sub
截图Excel:
清空Excel表格:
正确导入:
错误导入: