|
利用 Excel VBA 实现数据自动抽取汇总
作者:徐宝平 日期:2011年12月26日 公司:MTIW
前言:
对于电子工程师和测试工程师来说,最头疼的莫过于是整理测试了半天得到的数据,这些数据大部分是由软件自动测试生成并保存为.txt .log 等类似的文本格式。这些文本中的数据的分布的格式及文本的整体框架是一致的,这就为我们自动整理这些文本文件提供了条件。
下面我要介绍一款软件,它是基于Excel 和其中的VBA语言进行对文本格式的数据自动抽取和整理,并保存成我们自己定义的格式,前期介绍的是一维的格式数据整理,能将200多个文件的数据整理到一张sheet中。以便工程师分析和对比在不同条件下的前后数据的差异,从而找到问题的关键。
第一章 软件界面的介绍
这款软件的名称叫 标准相同格式文本整理-共享版.xls 之所以叫做共享版,是因为这是原软件的删改版,原软件是为我们公司特定的数据格式而编写的,能粗略的自动删改并对齐数据的格式,而这款软件只能对完全相同的数据格式的文本文件进行处理。如果大家有基本上格式相同的文本文件需要处理,可以发我,尽力修改成为您特制的数据整理软件。我的QQ :751623467,加好友的时候注明 “数据整理”。不过我一般不怎么上线,那就发我邮箱吧!
....中间省略 详情见附件
第3章 源程序的讲解
为了让大家能充分使用和理解这款软件现将整个程序的代码附上,包含了相当充分的注释,相信只要是有心人,一定能打造属于自己的数据自动整理软件。
Private Declare Function apiOpenClipboard Lib "user32" Alias "OpenClipboard" (ByVal hwnd As Long) As Long
Private Declare Function apiEmptyClipboard Lib "user32" Alias "EmptyClipboard" () As Long
Private Declare Function apiCloseClipboard Lib "user32" Alias "CloseClipboard" () As Long
Sub action_Click()
Dim filetoopen(100) As String '定义数组用于存放文件的路径 大小为100
Dim filename(100) As String '用于存放文件名不包含后缀名
Dim filenamesuffix(100) As String '用于存放文件名及后缀
Dim intI As Integer '用于数组的循环
Dim totalI As Integer '用于数组的大小
Dim totallist As Integer '用于数组的大小
Dim nextRow As String 'next row index
Dim MyArray() As String '定义动态数组
Dim arrayI As Integer '用于数组的大小 行
Dim arrayJ As Integer '用于数组的大小 列
'Dim fileSaveName1 As String '用于存放文件名
Dim xbp As String '临时用
Dim softname As String '存放运行程序的文件名
nextRow = 0
softname = ActiveWorkbook.Name
Windows(softname).Activate '将窗口提到 z-次序的最前面
Worksheets("Sheet2").Activate '激活sheet2
ActiveSheet.UsedRange.Delete '删除sheet2中已使用单元格中的数值
Worksheets("Sheet1").Activate '激活sheet1
totallist = Application.WorksheetFunction.CountA(Range("B6:B1006")) '得到需要整理项的个数,最大为200项
ReDim MyArray(totallist, 3) '重新定义动态数组的大小及维数
For arrayJ = 0 To 1
For arrayI = 0 To totallist - 1
MyArray(arrayI, arrayJ) = Worksheets("Sheet1").Range("C6").Offset(arrayI, arrayJ).Value
Next arrayI
Next arrayJ
Range("B6", Range("B6").End(xlDown)).Select '选择B6及以下全部有值的单元格
Selection.Copy
Sheets("Sheet2").Select
Range("A2").Select
ActiveSheet.Paste
Range("A1").Select
ActiveCell.FormulaR1C1 = "S/N"
Selection.HorizontalAlignment = xlCenter '居中
Sheets("Sheet1").Select
Range("G9").Select
totalI = Application.WorksheetFunction.CountA(Range("G9:G109")) '统计第7行第9列开始到结束的有值单元格格式
MsgBox totalI & "个文件待处理...请确认"
For intI = 0 To totalI - 1
Windows(softname).Activate '将窗口提到 z-次序的最前面
Sheets("Sheet1").Select
filetoopen(intI) = Worksheets("Sheet1").Range("G9").Offset(nextRow, 0).Value '将文件及路径放到数组filetoopen中
filename(intI) = Mid(filetoopen(intI), InStrRev(filetoopen(intI), "\", , vbTextCompare) + 1, _
InStrRev(filetoopen(intI), ".", , vbTextCompare) - InStrRev(filetoopen(intI), "\", , vbTextCompare) - 1)
filenamesuffix(intI) = Mid(filetoopen(intI), InStrRev(filetoopen(intI), "\", , vbTextCompare) + 1)
nextRow = nextRow + 1
Next intI
nextRow = 0
For intI = 0 To totalI - 1
Workbooks.OpenText filename:=filetoopen(intI), Origin:=936, StartRow:=1 _
, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False, Comma:=False, _
Space:=True, Other:=True, OtherChar:=":", FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:=True '打开待处理的文件
Cells.Select '选中打开的待处理文件中的所有单元格
Selection.Copy '复制选中内容
Windows(softname).Activate '将窗口提到 z-次序的最前面
Sheets("Sheet3").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("A1").Select
Windows(filenamesuffix(intI)).Activate
ActiveWindow.Close savechangs = fail '关闭活动的工作簿 不保存
Call myClr '清空剪切板 以释放内存
Windows(softname).Activate '将窗口提到 z-次序的最前面
'执行关键的汇总功能
Sheets("Sheet3").Select
For arrayI = 0 To totallist - 1 '从sheet3中指定位置(由数组的第1列决定)读出数据并放到数组的第3列
MyArray(arrayI, 2) = Worksheets("Sheet3").Range(MyArray(arrayI, 0)).Value
Next arrayI
Sheets("Sheet2").Select
For arrayI = 0 To totallist - 1 '将数组的第3列的数值放到sheet2的指定(由数组的第2列决定)位置
Worksheets("Sheet2").Range(MyArray(arrayI, 1)).Offset(0, nextRow).Value = MyArray(arrayI, 2)
Next arrayI
Range("B1").Offset(0, nextRow).Value = filename(intI)
nextRow = nextRow + 1
Next intI
Worksheets("Sheet3").Activate '激活sheet3
ActiveSheet.UsedRange.Delete '删除sheet3中已使用单元格中的数值
Worksheets("Sheet2").Activate '激活sheet2
'保存整理好的工作表
filesavename = Application.GetSaveAsFilename(fileFilter:="Excel Files(*.xls), * .xl * ", FilterIndex:=1, Title:="另存为")
If filesavename <> False Then
Sheet2.Activate
ActiveSheet.Copy
'MsgBox filesavename '显示待存入的文件名及路径 调试用
ActiveWorkbook.Close SaveChanges:=True, filename:=filesavename '新表关闭
Sheet2.Select
End If
End Sub
Sub open_sourcefile_Click()
Dim nfile As String
Dim nfiletemp As String
Dim nextRow As String 'next row index
Dim Filter As String '用于定义打开文件的类型
Dim filetoopen '定义为数组,存放需要打开的文件名
Dim intI As Integer '用于数组的循环
Dim totalI As Integer '用于存储数组的大小
Dim lastI As Integer '用于文件名开始的位置在字符串中起始位置
nextRow = 0 '定义下次的偏移大小
totalI = 0
Filter = "All Files(*.*),*.*,Word Documents(*.do*),*.do*," & _
"Text Files(*.txt),*.txt,Excel Files(*.xl*), * .xl * "
filetoopen = Application.GetOpenFilename(fileFilter:=Filter, FilterIndex:=1, Title:="请选择文件" _
, MultiSelect:=True)
If Not IsArray(filetoopen) Then
MsgBox "你没有选择文件", vbOKOnly, "提示"
For intI = 1 To 200 '将E9向下的200个单元格内容清空
Worksheets("Sheet1").Range("E9").Offset(nextRow, 0).Value = Null
Worksheets("Sheet1").Range("G9").Offset(nextRow, 0).Value = Null
nextRow = nextRow + 1
Next intI
nextRow = 0 '初始化偏移量
Else
With Worksheets("Sheet1").Range("E9")
For intI = 1 To 200 '将E9及G9向下的200个单元格内容清空
.Offset(nextRow, 0).Value = Null
.Offset(nextRow, 2).Value = Null
nextRow = nextRow + 1
Next intI
nextRow = 0 '初始化偏移量
totalI = UBound(filetoopen, 1) '得到FileToOpen中的一维数组的大小
For intI = 1 To totalI
nfile = filetoopen(intI)
nfiletemp = Mid(nfile, InStrRev(nfile, "\", , vbTextCompare) + 1) '在包含文件路径的字符串中提取文件名
.Offset(nextRow, 0).Value = nfiletemp
.Offset(nextRow, 2).Value = nfile
nextRow = nextRow + 1
Next intI
End With
End If
End Sub
Sub myClr()
apiOpenClipboard (0) '打开剪切板
apiEmptyClipboard '清空剪切板
apiCloseClipboard '关闭剪切板
End Sub
操作说明文件ourdev_708572XL6MG5.pdf(文件大小:649K) (原文件名:利用Excel VBA实现数据自动抽取汇总.pdf)
实际的数据整理软件ourdev_708573L3MI0P.xls(文件大小:92K) (原文件名:标准相同格式文本整理-共享版 .xls) |
阿莫论坛20周年了!感谢大家的支持与爱护!!
曾经有一段真挚的爱情摆在我的面前,我没有珍惜,现在想起来,还好我没有珍惜……
|