Excel VBA导入文本数组定义问题
Excel VBA导入文本数组定义问题
提问于 2018-09-19 02:06:52
我有一个包含30个选项卡的工作簿，它们都遵循相同的流程：
- 转至模板工作簿中的标签
- 使用数据导入例程显示CSV的数据，开始转储第7行的值。
- 完成后删除第7行(这是我们不需要的无用标题)
问题源于导入文本文件例程，该例程需要为每个工作表创建一个数组。我最终为每个工作表编写了40行代码，并且没有办法改变例程。这是一个由30部分组成的子部分的第一部分(所有部分都有类似的结构)：
'Use the Get Data routine to dump the csv onto the sheet as text/dates where appropriate, then delete line 7
Sheets("Sheet Alpha info").Select 'explicitly declare which sheet to dump onto
Application.CutCopyMode = False 'this is good programming
'this code section is the Get Data routine run in the UI, turned into VBA
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & ThisWorkbook.Path & "\sheet_alpha.CSV", _
Destination:=Range("$A$7")) 'important on every tab!
'.CommandType = 0 'this is only needed when you use the UI to do the routine, so currently commented out.
.Name = "sheet_alpha" 'could variablize this routine, but signficance of .Name is unknown in Import routine.
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437 'no idea what this actually is. encoding for UTF-8?
.TextFileStartRow = 1
.TextFileParseType = xlDelimited 'not set width
.TextFileTextQualifier = xlTextQualifierDoubleQuote 'yes, well-behaved CSV.
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True 'yes, well-behaved CSV.
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(2, 2, 2, 2, 2, 2, 2, 2, 2) 'this damn array is why we repeat the code. Need a new array for each sheet.
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
'and now remove the useless header line
Rows("7:7").Select
Selection.Delete Shift:=xlUp所以问题是:我如何改变这个例程并使其成为一个单独的FOR循环，该循环还将每个数组定义为纯文本数组(所以，TextFileColumnDataType ()每次都填充2)？
扩展:如果我想让数组读取其他数据类型(所以数组可能是Array(1，2，2，3，2，2，2))，我该怎么做呢？
回答 1
Stack Overflow用户
回答已采纳
发布于 2018-09-19 06:58:11
这里实际上只有3个变量:源文件、目标范围和字段类型数组。
您可以使用这3个参数将此代码包装在一个sub中，它应该可以很好地工作。唯一的挑战是确定每个文件的确切字段类型(假设这在这里很重要)
Sub Tester()
'eg - call directly
ImportFromText ThisWorkbook.Sheets("test").Range("A7"), _
ThisWorkbook.Path & "\test.csv", _
Array(2, 2, 2, 2, 2, 2, 2, 2, 2)
'...or from a worksheet table
Dim rw As Range
For Each rw in ThisWorkbook.Sheets("Files").Range("A2:C32").Rows
ImportFromText ThisWorkbook.Sheets(rw.Cells(1).Value).Range("A7"), _
ThisWorkbook.Path & "\" & rw.Cells(2).Value, _
Split(rw.Cells(3).Value, "|")
Next rw
End Sub
Sub ImportFromText(DestRange As Range, filePath As String, arrFieldTypes)
Dim sht As Worksheet, qt As QueryTable
Set sht = DestRange.Worksheet
'clear any previous....
Do While sht.QueryTables.Count > 0
sht.QueryTables(1).Delete
Loop
sht.UsedRange.Clear
Set qt = sht.QueryTables.Add(Connection:="TEXT;" & filePath, Destination:=DestRange)
With qt
'.CommandType = 0
.Name = "sheet_alpha"
.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 = arrFieldTypes
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
DestRange.EntireRow.Delete Shift:=xlUp 'and now remove the useless header line
End Sub页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/52392334
复制相关文章
相似问题