
本文于2023年5月28日首发于本人同名公众号,更多文章案例请搜索关注!
☆本期内容概要☆
VBA遍历文件夹下所有文件
批量颠倒数据
大家好,我是冷水泡茶,前几天在EXCELHOME论坛上看到一个网友求助的贴子:

当时也没有细想,以为是“颠倒两列”数据,就搞了一通发到论坛,在本公众号也发文(Excel VBA 遍历文件夹下所有文件/交换两列数据/AI全程高能对话写代码)。
第二天再到论坛上去看看,发现楼主的需求不是我想的那样,是头尾颠倒。
有点尴尬了,不过细想也没有什么,至少我们解决了一个两列数据交换的问题。
再想想如何完成头尾颠倒呢?由于楼主的数据量非常之大,据说有90万条,所以我想还是以数组处理吧。
其实也很简单,把原始数据读入数组A,再建一个同样大小的数组B,让i=1 to lastRow进行循环,B(lastRow-i+1)=A(i)。
把前文的代码稍事修改,模拟了80万行的数据,速度还是很快的。我们看一下代码:
Sub Upsidedown_Array() Dim folderPath As String Dim fileSystem As Object Dim folder As Object Dim file As Object Dim wb As Workbook Dim ws As Worksheet Dim data As Variant, arr() Dim lastRow As Long Dim temp As Variant Dim i As Long ' 获取当前目录路径 folderPath = ThisWorkbook.Path ' 创建文件系统对象 Set fileSystem = CreateObject("Scripting.FileSystemObject") Set folder = fileSystem.GetFolder(folderPath) ' 遍历文件夹下的.xlsb文件 For Each file In folder.Files If LCase(Right(file.Name, 5)) = ".xlsb" Then ' 仅处理.xlsb文件 ' 打开文件 Set wb = Workbooks.Open(file.Path) ' 遍历每个工作表 For Each ws In wb.Worksheets ' 获取数据范围 lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row arr = ws.Range("A1:B" & lastRow).Value data = arr ' 颠倒数据 For i = 1 To lastRow data(lastRow - i + 1, 1) = arr(i, 1) data(lastRow - i + 1, 2) = arr(i, 2) Next i ' 将结果写回工作表 ws.Range("A1:B" & lastRow).Value = data Next ws ' 保存并关闭文件 wb.Close SaveChanges:=True End If Next fileEnd Sub
主要是AI写的代码,注释比较详细,我就不多啰嗦了。
最近有点忙,在搞一个小项目《电子发票管理系统》,这是我壹年多前就完成了的一个小应用。主要解决电子发票文件归档与重复报销控制的问题。最近看到有人用VBA来读取PDF、OFD格式发票文件的信息,正好解决我这个发票管理系统的登记问题。通过代码读取发票信息,可以解决很多问题,这几天就在改代码,目前进展顺利,后面有机会再跟大家分享。
好,今天就到这吧,欢迎点赞、留言、分享,谢谢大家,我们下期再会。
☆猜你喜欢☆

本文使用 文章同步助手 同步,本文于2023年5月28日首发于本人同名公众号,更多文章案例请搜索关注!