[心得]字典第3课作业分析

sunjing-zxl

字典第三课作业，基本属于一类型的题目，我现在以“必做一的效果1”为例子来分析这类题目的思路和做法
效果二的分析在二楼

分析附件： 凑数分析.rar (8.84 KB, 下载次数: 98)

2012-1-4 09:32 上传

点击文件名下载附件

'这类题三大步：
'第一步：找出新数组的行数和列数(用redim定义数组)
'第二步：找出特殊赋值数据对规律赋值数据进行分析凑数
'第三步：找出循环到该数据的复制行号和列号
'心得：这类题万变不离其中,就是一句话找出规律凑数

1. 
   
2. Sub 必做1效果1_012_sunjing_zxl()
   
3. '定义变量,这个我一般是先写程序,然后后面要用什么变量就加什么。
   
4. '当然还有先想思路然后,然后看自己的思路需要什么就一次性定义什么变量
   
5.     Dim d As New Dictionary, d1 As New Dictionary, d2 As New Dictionary
   
6.     Dim arr, arr1()
   
7.     Dim i As Long, j As Long, n As Long, m As Long
   
8. '下面两句是一般是程序完成后最后添加
   
9.     Range("F1:IV1000").ClearContents '清空,可以说是90%以上VBA程序说必须的
   
10.     Range("F1:IV1000").NumberFormatLocal = "@" '自定义单元格格式,有数字当文本用的时候说必须的
    
11. '给数组赋值,毫无疑问,我们既然学习了数组就不能再用单元格循环
    
12. '不管它三七二十一,先把数据区域赋值给数组再说
    
13.     arr = Range("A1:D" & [A65536].End(xlUp).Row)
    
14. '真正的思路重下面开始了
    
15. '第一步：找出我们格式转换后的数据到底有多少行列
    
16. '我一般情况不喜欢用ReDim Preserve定义数组,我一贯思路就是先找出
    
17. '我们结果数组的总行总列然后直接用ReDim定义数组
    
18. '效果1的总行数是规定死了,每个仓库的种类站5行,有多的在列数上扩展
    
19. '那么我们计算行就是仓库种类数*5,而计算列呢?不需要找到每个仓库种类的个数。
    
20. '只需要最多的一个仓库种类有多少个就行了。而排列是每4组数据换列。而没换一次列是要占用5列。
    
21. '所以就用仓库该种类的个数除以4向上取证之后再乘以5就是我们需要的总列数。（而这个数只需要用最
    
22. '多的一个个数来计算就行了)
    
23.     For i = 2 To UBound(arr)
    
24.         d(arr(i, 1)) = d(arr(i, 1)) + 1
    
25.     Next i '看这个i循环,不用说这个字典的key是仓库种类,对应的item就是仓库每个种类的个数
    
26.     n = WorksheetFunction.Large(d.Items(), 1) '找出一个最大的item值
    
27.     m = d.Count '字典key个数及就是仓库种类数
    
28. 'm*5不就是行数了吗,Abs(Int(-n / 4)) * 5不就是列数了吗
    
29.     ReDim arr1(1 To m * 5, 1 To Abs(Int(-n / 4)) * 5) '定义我们的结果数组的范围。
    
30. '上面就是第一步,这类题不管三七二十一先把这一步写出绝对没错，而且也是需要的。我反正不喜欢用ReDim Preserve来定义数组
    
31. '第二步：本类题目的关键所在
    
32. '大家应该都知道做函数用到OFFSET,INDEX等函数就需要凑数,凑出我们说要的数来解决问题,那么我们这类的VBA也是一样--凑数
    
33. '下面凑数循环赋值具体思路见附件
    
34.     For i = 2 To UBound(arr)
    
35.         d1(arr(i, 1)) = d1(arr(i, 1)) + 1
    
36.         m = 1 + (d1.Count - 1) * 5
    
37.         For j = 1 To 4
    
38.             arr1(m, j) = arr(1, j) '特殊标题行的赋值,可以加一个判断(if d1(arr(i, 1))=1 才赋值,否则就不赋值了)
    
39. '循环赋值计算的关键(数组凑数赋值)
    
40.             arr1(m + ((d1(arr(i, 1)) - 1) Mod 4) + 1, Int((d1(arr(i, 1)) - 1) / 4) * 5 + j) = arr(i, j)
    
41.         Next j
    
42.     Next i
    
43.     Range("F1").Resize(UBound(arr1), UBound(arr1, 2)) = arr1
    
44. End Sub

复制代码

sunjing-zxl

下面在用第一题的效果二来说明一下思路，完全和效果1是一样的。
关键在于凑数

1. Sub 必做1效果2_012_sunjing_zxl()
   
2.     Dim d As New Dictionary, d1 As New Dictionary
   
3.     Dim d2 As New Dictionary, d3 As New Dictionary
   
4.     Dim arr, arr1()
   
5.     Dim i As Long, j As Long, n As Long, m As Long
   
6.     Range("F1:IV1000").ClearContents
   
7.     Range("F1:IV1000").NumberFormatLocal = "@"
   
8.     arr = Range("A1:D" & [A65536].End(xlUp).Row)
   
9.     '统计每个仓库名的个数
   
10.     For i = 2 To UBound(arr)
    
11.         d(arr(i, 1)) = d(arr(i, 1)) + 1
    
12.     Next i
    
13.     '添加两个计数器
    
14.     n = 1
    
15.     m = 0
    
16.     '统计每个仓库名所占行数(d2)
    
17.     '统计每个仓库名起点行号(d3)
    
18.     '行号不固定,列好固定所以需要计算数组的行数
    
19.     '由题意（5行是基本行数，超出5行就添加）
    
20.     '上面字典的item值是每个仓库的总个数
    
21.     '所以RoundUp((d.Items(i) + 1) / 3, 0),就是该仓库需要用的行数,而加上最低行数限制。用max比较取一个最大值即可
    
22.     For i = 0 To d.Count - 1
    
23.         'd2的item就是key所需要的行数
    
24.         d2(d.Keys(i)) = WorksheetFunction.max(WorksheetFunction.RoundUp((d.Items(i) + 1) / 3, 0), 5)
    
25.         'd3的item就是key的起点行号
    
26.         d3(d.Keys(i)) = n
    
27.         '计数器n计算下一个的起点行号
    
28.         m = d2(d.Keys(i))
    
29.         n = n + m
    
30.     Next i
    
31.     '最后的n值减1肯定就我们所需要数组的总行数了
    
32.     ReDim arr1(1 To n - 1, 1 To 14)
    
33.     '规律循环赋值（万变不离其中的凑数）
    
34.     For i = 2 To UBound(arr)
    
35.         '统计循环点得仓库类别及该类别的个数
    
36.         d1(arr(i, 1)) = d1(arr(i, 1)) + 1
    
37.         '分析标题需要站一行数据,所以每一类仓库前面5行只能放下14个
    
38.         '所以用D1的item值+1来判断是否超出15个,超出15就需要添加行数了
    
39.         If d1(arr(i, 1)) + 1 > 15 Then
    
40.             m = d3(arr(i, 1)) + 5    '超出5行的起点行号
    
41.             n = d2(arr(i, 1)) - 5    '增加的行数
    
42.             '用m,n来凑数达到行列变化
    
43.             m = (d1(arr(i, 1)) - 15) Mod n + m
    
44.             n = Int((d1(arr(i, 1)) - 15) / n) * 5
    
45.             For j = 1 To 4
    
46.                 arr1(m, n + j) = arr(i, j)
    
47.             Next j
    
48.         'else下面的就不说了 , 和效果1基本一样
    
49.         Else
    
50.             m = d3(arr(i, 1)) + d1(arr(i, 1)) Mod 5
    
51.             n = Int(d1(arr(i, 1)) / 5) * 5
    
52.             For j = 1 To 4
    
53.                 arr1(d3(arr(i, 1)), j) = arr(1, j)
    
54.                 arr1(m, n + j) = arr(i, j)
    
55.             Next j
    
56.         End If
    
57.     Next i
    
58.     Range("F1").Resize(UBound(arr1), UBound(arr1, 2)) = arr1
    
59. End Sub

复制代码

qushui

孙哥  辛苦了 很给力啊 赞一个！

EP学员

谢谢分享               

wcymiss

vba这样的思路用的比较少，函数倒是很常见

bbhiox

wcymiss 发表于 2012-1-13 09:10
vba这样的思路用的比较少，函数倒是很常见

不断提高并且不断学习

开心萝卜惠州

学习，谢谢分享！