ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 6892|回复: 4

[求助] Querytables导入文本中变量的使用问题?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2011-12-9 19:38 | 显示全部楼层 |阅读模式
录入并修改了一段导入文本文件的代码(如下):
基本思路是针对不同类型的文本,在一个sheet中先写好导入的参数,然后统一调用querytables来批量导入文本。
1、文本路径+文件名-用变量mydir & "\" & myname替代;
2、 .TextFileParseType = xlFixedWidth         'xlFixedWidth按固定宽度导入;xlDelimited '以限定符导入
是否也可以用变量来替代?
3、  .TextFileColumnDataTypes = Array(ThisWorkbook.Sheets("参数").Cells(91, 4).Value)              '原为:9, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2
        .TextFileFixedColumnWidths = Array(ThisWorkbook.Sheets("参数").Cells(91, 3).Value)         '原为:2, 7, 13, 12, 10, 12, 27, 12, 17, 25, 28, 31, 12, 11, 11, 14
Array()部分是否可以用单元格的输入的数据来替代?

试了一下,系统会报错,请高手指点。特别是2、3两点一直很困惑,网上也找不到资料,基本上只有1中采用变量形式来替代以批量导入同一类型的文本。
但缺少灵活性,我想再扩展一下,请问高手们可否试过。如果可以,那么就能利用EXCEL自带的功能做出一个较为通用的文本导入VBA程序。而不是采用
如:  FileName = Application.GetOpenFilename      Open FileName For Input As #1  
一类的方法。

请高手及版主不吝赐教!!!



With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;" & mydir & "\" & myname, Destination:=Range("$A$1"))
       ' 原文件名REP9950_07151_20111201.txt
         
         .Name = Left(myname, Len(myname) - 4)    '取文件名,去掉.txt的后缀!
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936 '中文
        .TextFileStartRow = 5 '从第五行开始导入
        .TextFileParseType = xlFixedWidth         'xlFixedWidth按固定宽度导入;xlDelimited '以限定符导入
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(ThisWorkbook.Sheets("参数").Cells(91, 4).Value)              '原为:9, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2
        .TextFileFixedColumnWidths = Array(ThisWorkbook.Sheets("参数").Cells(91, 3).Value)         '原为:2, 7, 13, 12, 10, 12, 27, 12, 17, 25, 28, 31, 12, 11, 11, 14
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

TA的精华主题

TA的得分主题

发表于 2011-12-9 20:32 | 显示全部楼层
.TextFileColumnDataTypes = Array(ThisWorkbook.Sheets("参数").Cells(91, 4).Value)
这句换成:
lscs = Split(ThisWorkbook.Sheets("参数").Cells(91, 4).Value, ",")
        ReDim lrr(UBound(lscs))
        For i = 0 To UBound(lscs)
            lrr(i) = Val(lscs)
        Next
        .TextFileColumnDataTypes = lrr
列宽的修改方式同上
.TextFileParseType = xlFixedWidth ,总共才两个参数,根据单元格内容,加个if判断也不麻烦吧。

TA的精华主题

TA的得分主题

 楼主| 发表于 2011-12-12 17:03 | 显示全部楼层
非常感谢mimicai,我回去试一下。
另一个问题是针对不同的报表名称,我想先写好对应的处理子程序SUB,如报表名为report01.txt,则相应的底层导入处理程序为sub Input_report01(mydir as string,myname as string,myColDataTypes as string,myColWidth as string),我想再请问一下,用CALL的方式是否可以用变量替代CALL后面的子SUB的名字,而且还要传递参数。如:dim cs as string   cs= “Input_" & left(myname,len(myname)-4) & "(mydir as string,myname as string,myColDataTypes as string,myColWidth as string)"    call cs   的形式,请赐教!!!谢谢。

TA的精华主题

TA的得分主题

 楼主| 发表于 2011-12-13 18:22 | 显示全部楼层
本帖最后由 goldowl2011 于 2011-12-13 18:25 编辑

终于把程序写出来,感谢mimicai提供的思路,谢谢。下面将部分自定义函数的代码贴出来供坛子里面的朋友参考:
Public Function Bat_ReportTxtInput(ByVal myDir As String, ByVal myName As String, ByRef mySplit As Object, ByRef mycolwidth As Object, ByRef myfield As Object, ByVal myStartRow As Double)     
'参数传递myDir -路径, myName -报表名, mySplit -报表数据分列类型设置, myField -报表表头(字段名),myColWidth-设置每列的列宽,myStartRow-设置导入文本开始行数
'Made by Goldowl2011   2011/12/13

On Error Resume Next

Application.DisplayAlerts = False
Application.ScreenUpdating = False

  Dim i&, J&, k&, p&
  Dim cs_split
  Dim cs_split2
  Dim cs_split3
  '对导入的字符串进行数组化处理,并作为参数传递到querytables中的三个参数
  Dim mySplit2
  Dim myColWidth2
  Dim myfield2
  Dim myParseType2 As Variant
  
  
   '修改传递参数mysplit部分
                 cs_split = Split(mySplit, ",")
                ReDim mySplit2(UBound(cs_split))
                For J = 0 To UBound(cs_split)
                    mySplit2(J) = Val(cs_split(J))
                    'MsgBox mySplit2(i)
                Next J
    '修改结束
  
    '修改传递参数mycolwidth部分
                 cs_split2 = Split(mycolwidth, ",")
                ReDim myColWidth2(UBound(cs_split2))
                For k = 0 To UBound(cs_split2)
                    myColWidth2(k) = Val(cs_split2(k))
                Next k
               
     '修改结束
               
    '修改传递参数myfield部分
                myfield2 = Split(myfield, ",")
               
                ' cs_split3 = Split(myField, ",")
                'ReDim myField2(UBound(cs_split3))
                'For p = 0 To UBound(cs_split3)
                '    myField2(p) = Val(cs_split3(p))
                'Next p
               
     '修改结束
     
               

'-------------------------------预设开始
ActiveWorkbook.Worksheets.add '添加一个新表
ActiveWorkbook.ActiveSheet.Name = Split(myName, "_")(0) & "_" & Split(myName, "_")(1) & "_" & ActiveWorkbook.Sheets.count '以文件名的前两段+工作表最大编号构成工作表名

ActiveWorkbook.ActiveSheet.Range("A:VI").NumberFormatLocal = "@"  '设256列为文本格式
  
'--------------------------------查询开始

With ActiveWorkbook.ActiveSheet.QueryTables.add(Connection:="TEXT;" & myDir & myName, Destination:=Range("$A$1"))
        .Name = Left(myName, Len(myName) - 4)    '取文件名,去掉.txt的后缀!
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 936 '中文
        .TextFileStartRow = myStartRow             '以参数替代   
        .TextFileParseType = xlFixedWidth          '以固定列宽导入方式,xlFixedWidth按固定宽度导入;xlDelimited '以限定符导入
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = mySplit2                     '以参数替代Array(9, 2, 2, 2, 2)   
        .TextFileFixedColumnWidths = myColWidth2                '以参数替代Array(2, 7, 13, 12, 10)     
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
End With
'----------------------------------写表头字段


With ActiveWorkbook.ActiveSheet
   '.Rows(1).Clear'删除第一行内容
   
  .Rows("1:1").Insert Shift:=xlDown '在第一行插入一行以写入表头部分
  .Range("A1").Resize(, UBound(myField2) + 1) = myField2                        'WorksheetFunction.Transpose(myField2)               '若为取一维数组时则需要转置!
   
   'Columns("H:H").Style = "Comma"    '定义H列为货币样式
   'Range("B:B").NumberFormatLocal = "@"  '文本格式
   'Range("C:C").NumberFormatLocal = "yyyy-m-d"  '日期格式
' Columns("A:Z").EntireColumn.AutoFit

End With

'---------------------------------
  Application.DisplayAlerts = True
  Application.ScreenUpdating = True
     
   

End Function


‘=======================
主程序中需要定义公共变量
Public myDir As String   '报表路径
Public myName As String  '报表名
Public mySplit As String   '报表数据分列类型设置(9不导入,2文本,1常规)
Public mySplit As Object   '报表数据分列类型设置(9不导入,2文本,1常规)
Public myfield As Object  '报表表头(字段名)
Public mycolwidth As Object  '报表数据分列每列列宽
Public myParseType As Variant ' 'xlFixedWidth按固定宽度导入;xlDelimited '以限定符导入
Public myStartRow As Double  '开始导入行数

在SUB中要将变量提取与“参数”工作表的数据关联起来取数
通过用户输入的信息-如目录、文件关键字、报表关键字等信息,使用查询语句获取“参数”表中对应的参数
如:mysplit,mycolwidth,myfield,mystartrow等信息,
然后调用上面的自定义函数,将单个文本写入到EXCEL中,
再通过主程序的循环,将多个文本读取到EXCEL中,
同时,再将单个导入文本中的数据COPY到汇总工作表,
删除多余数据,
删除新生成的工作表,
保留汇总数据工作表,再给加个表头,搞个格式什么的,
哈哈,大功告成!!!

TA的精华主题

TA的得分主题

发表于 2014-6-5 20:51 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-8-22 10:31 , Processed in 0.072869 second(s), 13 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表