|
Q: 如何利用vba代码对特定排序规则条件区间内的图书内容进行统计?
A: 规则说明如下:
在对馆藏的分类号字段进行了这种特殊“优先”次序规则的排序后,便是进行各个图书分类的种、册和总价。因为图书分类的特殊性,一般要求统计出分类号以什么什么开头的图书有多少种、多少册、总价值多少(比如统计以“E2”打头的有多少种、多少册、总价值多少),或者统计从什么什么开头到什么什么开头的图书又有多少种、多少册、总价值多少(比如统计从以“E”打头的第一本图书开始到以“E5”打头的最后一本图书止,这中间共有多少种、多少册、总价值多少的图书)。
一、分类号的比较是逐字符的;
二、分类号字符的优先顺序是:
a NULL / - ( ) “ ” = < > : + 0 1 2 3 4 5 6 7 8 9 A B C D E F G H I J K L M N O P Q R S T U V W X Y Z .
三、[]中的内容需包含在内,{}中内容为不包含在内
示例说明如下:
说明下为什么"[F12]~{F89}"这个区间还包括F2,F3,...,F7
对于前面两字符都是“F1”的 F12、F13、……、F18、F19 而言,显然有 F12《F13《……《F18《F19。
同理对于首字符都为“F”的 F1、F2、……、F7、F8 而言,又有 F1《F2《……《F7《F8。
而对于统计分类号 F1 而言,它是包括了 ……、F12、F13、……、F18、F19等等的,所以,又有
F12《F13《……《F18《F19《……《F2《F3《……《F7《F8。
而根据上面的分类号字符的优先顺序,“a”排在NULL前,NULL排在“/”前,“/”排在“-”前,……,“+”排在“0”前,“0”排在“1”前,……,因此对于前面两字符都是“F8”的 F8a、F8、F8/、F8-、……、F8+、F80、F81、…… 而言,又有 F8a《F8《F8/《F8-《……《F8+《F80《F81《……
实现代码如下: - Sub 条件汇总()
- Dim Rule, Arr, Arrt, Arr2, Arr3, Result, Dic As Object, Dic2 As Object, Dic3 As Object, N&, I&, T&, Str$, Str2$
- Rule = Split("a,,/,-,(,),", ",=,<,>,:,+,0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,.", ",") '生成排序规则数组
- Set Dic = CreateObject("scripting.dictionary") '创建字典项目,字典1和2用于保存前两位字符及序号,key与item相反,以方便进行反查,字典3用于统计最终结果
- Set Dic2 = CreateObject("scripting.dictionary")
- Set Dic3 = CreateObject("scripting.dictionary")
- T = 1 '初始化序号为1
- For N = Asc("A") To Asc("Z") '生成字符序列并保存对应序号
- For I = LBound(Rule) To UBound(Rule)
- Str = Chr(N) & Rule(I)
- If Not Dic.exists(Str) Then
- Dic(Str) = T
- Dic2(CStr(T)) = Str
- T = T + 1
- End If
- Next I
- Next N
- With ActiveSheet '针对活动工作表
- Result = .[i1].Resize(.Cells(.Rows.Count, "I").End(3).Row, 5).Value '取得结果区内容存入数组中
- For N = LBound(Result) + 1 To UBound(Result) '循环结果数据中各数据行
- For I = LBound(Result, 2) To UBound(Result, 2) '循环结果数据各列
- If I >= LBound(Result, 2) + 2 Then '结果数据区清0
- Result(N, I) = 0
- ElseIf I = LBound(Result, 2) Then '提取数据规则区位置规则内容拆分到数组中
- Arr2 = Split(Replace(Result(N, I), " ", ""), "~")
- Else '提取数据规则区分类号规则内容到数组中
- Arr3 = Split(Replace(Result(N, I), " ", ""), "~")
- End If
- Next I
- If Trim(CStr(Arr2(LBound(Arr2)))) = "0" Then '如果位置规则为0,则重置数组,分别写入起始号1和终止号9
- ReDim Arr2(1 To 2)
- Arr2(1) = 1
- Arr2(2) = 9
- Else '否则循环提取出规定的起止号
- For I = LBound(Arr2) To UBound(Arr2) '循环位置数组各项
- If Arr2(I) Like "[[{]*" Then Arr2(I) = Right(Arr2(I), Len(Arr2(I)) - 1) '判断是否有中括号或大括号,有则去除左侧括号(方便后面提取数值)
- If Arr2(I) Like "*}*" Then '判断是否有右大括号存在,有则提取的值要减1
- Arr2(I) = Val(Arr2(I)) - 1
- Else
- Arr2(I) = Val(Arr2(I))
- End If
- Next I
- End If
- For I = LBound(Arr3) To UBound(Arr3) '循环分类号数组各项
- Arr3(I) = Replace(Arr3(I), " ", "") '替换掉可能存在的空格
- If Arr3(I) Like "*[[]*" Then '判断是否有中括号,有则替换掉,并提取出对应的字典中序号存入数组当前项
- Arr3(I) = Dic(Replace(Replace(Arr3(I), "[", ""), "]", ""))
- ElseIf Arr3(I) Like "*[{]*" Then '判断是否有大括号,有则替换掉,并提取出对应的字典中序号减去1存入数组当前项
- Arr3(I) = Dic(Replace(Replace(Arr3(I), "{", ""), "}", "")) - 1
- Else '其他情况直接提取对应序号
- Arr3(I) = Dic(Arr3(I))
- End If
- Next I
- For I = Val(Arr2(LBound(Arr2))) To Val(Arr2(UBound(Arr2))) '循环生成所需结果,分类成数组方式存入字典3中
- For T = Val(Arr3(LBound(Arr3))) To Val(Arr3(UBound(Arr3)))
- Str = I & vbTab & Dic2(CStr(T)) '组合对应的位置及分类号头
- If Dic3.exists(Str) Then '判断储存结果的字典3中是否存在,存在则将item项中数组提取出并添加进对应的结果数组中的行号
- Arrt = Dic3(Str)
- ReDim Preserve Arrt(LBound(Arrt) To UBound(Arrt) + 1)
- Arrt(UBound(Arrt)) = N
- Dic3(Str) = Arrt
- Else '不存在时新建数组,写入行号并存为对应的item项
- ReDim Arrt(1 To 1)
- Arrt(1) = N
- Dic3(Str) = Arrt
- End If
- Next T
- Next I
- Next N
- Dic.RemoveAll '清空字典1和2
- Dic2.RemoveAll
- Arr = .[a1].Resize(.Cells(.Rows.Count, 2).End(3).Row, 5).Value '取得数据源中的数据
- For N = LBound(Arr) + 1 To UBound(Arr) '循环数组源中的数据区各行
- Arr(N, 2) = Left(Replace(Arr(N, 2), " ", ""), 2) '对数据进行整理,清除需判断内容中可能存在的空格
- Arr(N, 4) = Trim(Arr(N, 4))
- Str = Arr(N, 4) & vbTab & Left(Arr(N, 2), 1) '组合当前行图书的储存位置和分类号前一位
- If IsArray(Dic3(Str)) Then '判断是否存在对应的字典项是否为数组(即是否属规则中需统计的内容),如果是,则
- Arrt = Dic3(Str) '提取出对应的数组
- For I = LBound(Arrt) To UBound(Arrt) '循环数组各项
- If Len(Result(Arrt(I), 2)) = 1 Then '如果对应的结果数组中的规则字符长度为1(即需要统计所有以此字符开头且位置号对应的书籍),则
- Result(Arrt(I), 3) = Result(Arrt(I), 3) + 1 '对应的册数加1
- Dic(Arrt(I) & vbTab & vbTab & N) = "" '添加标识到字典中,防止重复统计
- Result(Arrt(I), 5) = Result(Arrt(I), 5) + Arr(N, 5) '金额总数相加
- Str2 = Arrt(I) & vbTab & vbTab & Trim(Arr(N, 3)) '组合结果表行号与书名
- If Not Dic.exists(Str2) Then '判断是否存在对应字典项,以防止存书种类数重复统计
- Result(Arrt(I), 4) = Result(Arrt(I), 4) + 1 '不存在时存书种类加1
- Dic(Str2) = "" '添加对应标识
- End If
- End If
- Next I
- Dic(Str) = "" '已统计过内容添加标识到字典
- End If
- Str = Trim(Arr(N, 4)) & vbTab & Left(Arr(N, 2), 2) '组合位置和分类号前两位
- If IsArray(Dic3(Str)) Then '判断是否存在对应的字典项是否为数组(即是否属规则中需统计的内容),如果是,则
- Arrt = Dic3(Str) '提取出对应的数组
- For I = LBound(Arrt) To UBound(Arrt) '循环数组各项
- If Not Dic.exists(Arrt(I) & vbTab & vbTab & N) Then '如果该项未被统计过,则进行统计
- Result(Arrt(I), 3) = Result(Arrt(I), 3) + 1
- Result(Arrt(I), 5) = Result(Arrt(I), 5) + Arr(N, 5)
- End If
- Str2 = Arrt(I) & vbTab & vbTab & Trim(Arr(N, 3)) '组合结果行号和书名
- If Not Dic.exists(Str2) Then '当对应内容未被统计过时
- Result(Arrt(I), 4) = Result(Arrt(I), 4) + 1 '存书种类加1
- Dic(Str2) = "" '添加标识
- End If
- Next I
- End If
- Next N
- .[o1].Resize(UBound(Result), UBound(Result, 2)) = Result '全部统计完成后,向结果区写入结果数据
- End With
- Set Dic = Nothing '清空字典项目
- Set Dic2 = Nothing
- Set Dic3 = Nothing
- End Sub
|
|