[已解决]求助统计文件类型数量的VBA，各位老师辛苦了

zhycl · 发表于 2013-7-29 14:15

一个文件夹中包含有若干个命名有规则的EXCEL文件，现在想统计一下各种类型文件和各个单位的数量。将统计结果放入“统计表”中。示例文件夹中，只简单罗列几个文件做附件。
需要统计的文件命名规则为：A+单位编码（6位数字）+编号（四位）；B+单位编码（6位数字）+编号（四位）；C+单位编码（6位数字）+编号（四位）； D+单位编码（6位数字）+编号（四位），共四中文件类型A、B、C、D，每类文件又分为16个单位（编码依次031000、031001、。。。。。031015），想按照文件类型和单位不同，分别统计各单位中各类文件的数量。见示例。
谢谢了

示例.rar (21.85 KB, 下载次数: 17)

ligh1298 · 发表于 2013-7-29 15:20

楼主：是不是想要这样的？见附件！要启用宏（即把宏安全性设置成“低”），点击按钮完成。

hwc2ycy · 发表于 2013-7-29 15:25

Sub SumFile()
Dim arr()
Dim i As Long
Dim arrCol, arrResult()
Dim strGroup As String * 1, strCompany As String * 6
Dim strPath As String, strFile As String
Dim lRow As Long, lCol As Long
Dim objDic As Object
Application.ScreenUpdating = False
arrCol = Array(2, 10, 16, 21)
i = Cells(Rows.Count, 1).End(xlUp).Row
arr = Range("a6:b" & i).Value
Set objDic = CreateObject("scripting.dictionary")
For i = LBound(arr) To UBound(arr)
objDic(arr(i, 1)) = i
Next
ReDim arrResult(1 To UBound(arr), 1 To UBound(arrCol) + 1)
For i = 65 To 68
objDic(Chr(i)) = i - 64
Next
strPath = ThisWorkbook.Path & Application.PathSeparator
strFile = Dir(strPath & "*.xls")
Do While Len(strFile)
If strFile <> ThisWorkbook.Name Then
strGroup = Left(strFile, 1)
strCompany = Mid(strFile, 2, 6)
If objDic.exists(strGroup) And objDic.exists(strCompany) Then
lCol = objDic(strGroup)
lRow = objDic(strCompany)
arrResult(lRow, lCol) = arrResult(lRow, lCol) + 1
Debug.Print strFile & ":" & strGroup & ":" & strCompany & ":" & lRow & ":" & lCol
End If
End If
strFile = Dir
Loop
For i = LBound(arrCol) To UBound(arrCol)
Cells(6, arrCol(i)).Resize(UBound(arrResult)).Value = WorksheetFunction.Index(arrResult, 0, i + 1)
Next
Set objDic = noting
Application.ScreenUpdating = True
MsgBox "汇总完成", vbInformation + vbOKOnly
End Sub

复制代码

zjdh · 发表于 2013-7-29 15:36

本帖最后由 zjdh 于 2013-8-1 13:52 编辑

示例.rar (29.03 KB, 下载次数: 45)

zjdh · 发表于 2013-7-29 15:41

本帖最后由 zjdh 于 2013-8-1 13:49 编辑

Sub test()
Set D = CreateObject("scripting.dictionary")
ARR = Range("A6:A" & Range("A65536").End(3).Row)
ReDim BRR(1 To UBound(ARR), 1 To 4)
FL = Dir(ThisWorkbook.Path & "\*.xls")
Do While FL <> ""
If FL <> ThisWorkbook.Name Then D(Left(FL, 7)) = D(Left(FL, 7)) + 1
FL = Dir
Loop
K = D.KEYS
For I = 1 To UBound(ARR)
For J = 0 To UBound(K)
If ARR(I, 1) = Right(K(J), 6) Then BRR(I, Asc(Left(K(J), 1)) - 64) = D(K(J))
Next
Next
For I = 1 To UBound(BRR)
Cells(I + 5, 2) = BRR(I, 1)
Cells(I + 5, 10) = BRR(I, 2)
Cells(I + 5, 16) = BRR(I, 3)
Cells(I + 5, 21) = BRR(I, 4)
Next
End Sub

复制代码

zhycl · 发表于 2013-7-31 21:38

ligh1298 发表于 2013-7-29 15:20
楼主：是不是想要这样的？见附件！要启用宏（即把宏安全性设置成“低”），点击按钮完成。

你好，您给的示例，点击后好像 B开头的数量里面加上了 A开头的数量，数据不太对，您再给看看

zhycl · 发表于 2013-7-31 21:40

本帖最后由 zhycl 于 2013-7-31 21:57 编辑

zjdh 发表于 2013-7-29 15:36

老师，我在实际应用中A开头的表个数达到26个了，B开头的有14个，C开头1个，D开头10个，我是这么做的，下载您的示例，把我的表全部拷贝到里面，和我自己新建一张统计表，写入您给的代码得到的结果都一样，如下：用示例得到的结果，只有A开头的数量，其他的一概没有数量
。求解

zhycl · 发表于 2013-7-31 22:26

hwc2ycy 发表于 2013-7-29 15:25

请教老师，您给的代码我运行后提示 “运行时错误 424 要求对象” 改怎么解决啊

hwc2ycy · 发表于 2013-7-31 22:45

zhycl 发表于 2013-7-31 22:26
请教老师，您给的代码我运行后提示 “运行时错误 424 要求对象” 改怎么解决啊

不知道你实际应用时的情况，没法判断问题在哪，或者你出错时点调试看看代码停在哪一行了。

zhycl · 发表于 2013-7-31 23:04

hwc2ycy 发表于 2013-7-31 22:45
不知道你实际应用时的情况，没法判断问题在哪，或者你出错时点调试看看代码停在哪一行了。

我点击运行后，出现如下： QQ截图20130731230337.jpg

然后，点击确定，就什么提示也没有了

		自动登录	找回密码
密码			注册

[已解决]求助统计文件类型数量的VBA，各位老师辛苦了

相关帖子

评分