VBA汇总统一文件夹下的多个表格的数据?

VBA汇总统一文件夹下的多个表格的数据?,第1张

大家好,今天继续讲解《VBA数据库解决方案》,今日讲解的是第37讲,利用ADO,实现同一文件夹下多个EXCEL工作表的数据汇总。最近的内容实用性比较强,如今日的内容,只把需要汇总的EXCEL文件放在同一个文件夹下,而且格式一致,那么利用ADO汇总这几个文件的数据是非常快的,这讲的内容和第32讲的内容是类似的,不过第32讲的内容是要事先知道文件的名称,然后建立一个数组来分别对应每个文件,通过循环来实现从每个文件中提取数据的目的,本讲的内容是事先不知道每个文件的名称。

实例:在一个文件夹下有若干个文件,如下图:

我们现在,需要把上面的文件夹中除了“VBA与数据库 *** 作”之外的各个文件的内容一次性汇总出来,这个VBA程序该如何写呢?代码如下:

Sub mynzexcels_6()

'第37讲,利用ADO,实现同一文件夹下EXCEL工作表数据的汇总

Dim cnADO As Object

Dim strPath, strTable, strSQL, Z As String

Set cnADO = CreateObject("ADODB.Connection")

Range("a:g").ClearContents

Range("a1:e1") = Array("日期", "型号", "批号", "出库数量", "库存数量")

Z = Dir(ThisWorkbook.Path &"\*.*")

strPath = ThisWorkbook.Path &"\" &Z

strTable = "[sheet1$A2:h65536]"

'建立连接,提取数据

x = 2

Do While Z <>""

If Z <>"VBA与数据库 *** 作.xlsm" Then

cnADO.Open "provider=Microsoft.ACE.OLEDB.12.0extended properties='excel 8.0hdr=noimex=1'data source=" &strPath

strSQL = "select F1,F2,F3,F4,F5 from " &strTable

Range("A" &x).CopyFromRecordset cnADO.Execute(strSQL)

x = Range("b65536").End(xlUp).Row

cnADO.Close

End If

Z = Dir

Loop

Set cnADO = Nothing

End Sub

代码截图:

代码讲解:

1 Z = Dir(ThisWorkbook.Path &"\*.*") 其中DIR函数用来指定文件名的字符串表达式,可能包含目录或文件夹、以及驱动器。如果没有找到 pathname,则会返回零长度字符串 ("")。

2 strPath = ThisWorkbook.Path &"\" &Z

strTable = "[sheet1$A2:h65536]"

上述代码分别给出了文件的路径名称和数据表的范围,数据的范围是sheet1工作表除去表头后的全部$A2:h65536.

3 strSQL = "select F1,F2,F3,F4,F5 from " &strTable

Range("A" &x).CopyFromRecordset cnADO.Execute(strSQL)

建立连接后把需要的数据拷贝出来,需要的数据是第1列,第2列,第3列,第4列 ,第5列

4 x = Range("b65536").End(xlUp).Row 下次复制的位置确定.

5 Z = Dir

特别注意:第一次调用 Dir 函数时,必须指定 pathname,否则会产生错误。如果也指定了文件属性,那么就必须包括 pathname。Dir 会返回匹配 pathname 的第一个文件名。若想得到其它匹配 pathname 的文件名,再一次调用 Dir,且不要使用参数。如果已没有合乎条件的文件,则 Dir 会返回一个零长度字符串 ("")。一旦返回值为零长度字符串,并要再次调用 Dir 时,就必须指定 pathname,否则会产生错误。不必访问到所有匹配当前 pathname 的文件名,就可以改变到一个新的 pathname 上。但是,不能以递归方式来调用 Dir 函数。以 vbDirectory 属性来调用 Dir 不能连续地返回子目录。由于文件名并不会以特别的次序来返回,所以可以将文件名存储在一个数组中,然后再对这个数组排序。

上述的Z=dir 就是实现的下一个文件名的调用。

下面看运行的结果:

点击“ADO实现同文件夹下所有文件数据汇总”按钮:

汇总后再A到E列给出了数据的汇总:

今日内容回向:

1 在不知道文件名和文件个数的前提下,如何汇总文件?

2 DIR函数的意义是否理解?

在Excel中取得某列最后一行的VBA代码怎么写(各列行数不同)?

A列最后一行

LastRow = Cells(Rows.Count, 1).End(xlUp).Row

B列最后一行

LastRow = Cells(Rows.Count, 2).End(xlUp).Row

一. 基本概念

Microsoft Excel是微软公司的办公软件Microsoft office的组件之一,是由Microsoft为Windows和Apple Macintosh *** 作系统的电脑而编写和运行的一款试算表软件。Excel 是微软办公套装软件的一个重要的组成部分,它可以进行各种数据的处理、统计分析和辅助决策 *** 作,广泛地应用于管理、统计财经、金融等众多领域。

二. 软件延伸

目前许多软件厂商借助Excel的友好界面和强大的数据处理功能开始研究将其以更简单的方式应用到企业管理和流程控制中,比如ESSAP(Excel&SQL平台)就是很好的应用Excel和数据库软件MS SQL相结合应用到企业管理和各行各业数据处理的例子。

ESSAP是一个用于构建信息系统的设计与运行平台。其以Excel为 *** 作界面,结合大型数据库MS SQL与工作流技术,用户只要运用自己已经掌握的Excel *** 作技术(不需依靠专业IT人员),就可以设计满足自己需要(管理意图)的各种信息管理系统。另外,系统设计完成并投入使用以后,并不意味着系统就从此不能改变,而是还可以根据管理的需要进行不断的优化与扩展功能,真正做到了“持续优化,因需而变”,使到你自己设计的系统永不落伍。

excel里面怎么求得某列中某个数字出现的最后一行的行数?用函数。

用数组函数

=MAX(IF(A1:A6=38,ROW(A1:A6),0))

输入完成后按 ctrl+shift+enter 结束

Excel VBA 找到某一行的最后一个非空单元格 用VBA代码怎么写阿 本人VBA小白

iCol=Cells(1,colunms.count).end(xltoleft).column

这是第1行的

vba 获取excel表中某列(列号假设为A)的行数,求代码

r= range("A65536").end(xlup).row

excel VBA想让某行的A到Z列清空,代码怎么写?

if cells(i,5).value="" then

range(cells(i,"a"),cells(i,"z").clear

end if

如何取得datagridview中最后一行某列的数据

1、你这是Winform还是WebForm?

2、感觉你是用错了事件,而非用错了代码。你能否说下你为啥要用KEYPRESS事件?

一般我都用别的事件,比如RowUpdated之类的。

3、还有一种方法是使用支持INotifyChanged接口的对象,然后在对象的PropertyChanged事件里面写代码。

4、所以关键还是你想作啥

excel2007 VBA编程怎么取得某一行的最大有效列数?

假如是i行:

cells(i,columns.count).end(xltoletf).column

求老师指教:vba怎么统计excel某一行最后一列的列数?

不用循环,假设是第15行,最后一列是:

Cells(15, Columns.Count).End(xlToLeft).Column

Excel 如何通过VBA找出最后一行数据所在的列

一般有两个方法,一是使用ActiveSheet.UsedRange,这个表示所有已经使用的区域,一般可以赋值给数组完成所有数据的读取,也可以使用ActiveSheet.UsedRange.Rows.Count和ActiveSheet.UsedRange.Columns.Count获得区域的行列数量。

另外,可以使用End获得某行(或者某列)最后一个数据,例如需要获得A列最后一个数据所有在行可以用:

ActivceSheet.Cells(ActivceSheet.Rows.Count,1).End(XlUp).Row

假设两个表都是从A列开始的,用下面代码可以实现

Sub cz()

Sheets("sheet2").Select

Range("a3:a100").ClearContents

Set sh1 = Sheets("sheet1")

x = sh1.[a65536].End(xlUp).Row

n = 3

For i = 2 To x

With sh1

If .Cells(i, 1) = [b1] Then

Cells(n, 1) = .Cells(i, 1)

Cells(n, 2) = .Cells(i, 2)

Cells(n, 3) = .Cells(i, 3)

Cells(n, 4) = .Cells(i + 1, 1)

Cells(n, 5) = .Cells(i + 1, 2)

Cells(n, 6) = .Cells(i + 1, 3)

n = n + 1

For j = i + 1 To x

If .Cells(j, 3) = .Cells(i, 3) Then

Cells(n, 1) = .Cells(j, 1)

Cells(n, 2) = .Cells(j, 2)

Cells(n, 3) = .Cells(j, 3)

Cells(n, 4) = .Cells(j + 1, 1)

Cells(n, 5) = .Cells(j + 1, 2)

Cells(n, 6) = .Cells(j + 1, 3)

End If

Next

End If

End With

Next

End Sub


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/sjk/6777157.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-03-28
下一篇 2023-03-28

发表评论

登录后才能评论

评论列表(0条)

保存