[心得]字典第3课作业分析
本帖最后由 sunjing-zxl 于 2012-1-4 10:11 编辑字典第三课作业，基本属于一类型的题目，我现在以“必做一的效果1”为例子来分析这类题目的思路和做法
效果二的分析在二楼
分析附件：
'这类题三大步：
'第一步：找出新数组的行数和列数(用redim定义数组)
'第二步：找出特殊赋值数据对规律赋值数据进行分析凑数
'第三步：找出循环到该数据的复制行号和列号
'心得：这类题万变不离其中,就是一句话找出规律凑数
Sub 必做1效果1_012_sunjing_zxl()
'定义变量,这个我一般是先写程序,然后后面要用什么变量就加什么。
'当然还有先想思路然后,然后看自己的思路需要什么就一次性定义什么变量
Dim d As New Dictionary, d1 As New Dictionary, d2 As New Dictionary
Dim arr, arr1()
Dim i As Long, j As Long, n As Long, m As Long
'下面两句是一般是程序完成后最后添加
Range("F1:IV1000").ClearContents '清空,可以说是90%以上VBA程序说必须的
Range("F1:IV1000").NumberFormatLocal = "@" '自定义单元格格式,有数字当文本用的时候说必须的
'给数组赋值,毫无疑问,我们既然学习了数组就不能再用单元格循环
'不管它三七二十一,先把数据区域赋值给数组再说
arr = Range("A1:D" & .End(xlUp).Row)
'真正的思路重下面开始了
'第一步：找出我们格式转换后的数据到底有多少行列
'我一般情况不喜欢用ReDim Preserve定义数组,我一贯思路就是先找出
'我们结果数组的总行总列然后直接用ReDim定义数组
'效果1的总行数是规定死了,每个仓库的种类站5行,有多的在列数上扩展
'那么我们计算行就是仓库种类数*5,而计算列呢?不需要找到每个仓库种类的个数。
'只需要最多的一个仓库种类有多少个就行了。而排列是每4组数据换列。而没换一次列是要占用5列。
'所以就用仓库该种类的个数除以4向上取证之后再乘以5就是我们需要的总列数。（而这个数只需要用最
'多的一个个数来计算就行了)
For i = 2 To UBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) + 1
Next i '看这个i循环,不用说这个字典的key是仓库种类,对应的item就是仓库每个种类的个数
n = WorksheetFunction.Large(d.Items(), 1) '找出一个最大的item值
m = d.Count '字典key个数及就是仓库种类数
'm*5不就是行数了吗,Abs(Int(-n / 4)) * 5不就是列数了吗
ReDim arr1(1 To m * 5, 1 To Abs(Int(-n / 4)) * 5) '定义我们的结果数组的范围。
'上面就是第一步,这类题不管三七二十一先把这一步写出绝对没错，而且也是需要的。我反正不喜欢用ReDim Preserve来定义数组
'第二步：本类题目的关键所在
'大家应该都知道做函数用到OFFSET,INDEX等函数就需要凑数,凑出我们说要的数来解决问题,那么我们这类的VBA也是一样--凑数
'下面凑数循环赋值具体思路见附件
For i = 2 To UBound(arr)
d1(arr(i, 1)) = d1(arr(i, 1)) + 1
m = 1 + (d1.Count - 1) * 5
For j = 1 To 4
arr1(m, j) = arr(1, j) '特殊标题行的赋值,可以加一个判断(if d1(arr(i, 1))=1 才赋值,否则就不赋值了)
'循环赋值计算的关键(数组凑数赋值)
arr1(m + ((d1(arr(i, 1)) - 1) Mod 4) + 1, Int((d1(arr(i, 1)) - 1) / 4) * 5 + j) = arr(i, j)
Next j
Next i
Range("F1").Resize(UBound(arr1), UBound(arr1, 2)) = arr1
End Sub
下面在用第一题的效果二来说明一下思路，完全和效果1是一样的。
关键在于凑数Sub 必做1效果2_012_sunjing_zxl()
Dim d As New Dictionary, d1 As New Dictionary
Dim d2 As New Dictionary, d3 As New Dictionary
Dim arr, arr1()
Dim i As Long, j As Long, n As Long, m As Long
Range("F1:IV1000").ClearContents
Range("F1:IV1000").NumberFormatLocal = "@"
arr = Range("A1:D" & .End(xlUp).Row)
'统计每个仓库名的个数
For i = 2 To UBound(arr)
d(arr(i, 1)) = d(arr(i, 1)) + 1
Next i
'添加两个计数器
n = 1
m = 0
'统计每个仓库名所占行数(d2)
'统计每个仓库名起点行号(d3)
'行号不固定,列好固定所以需要计算数组的行数
'由题意（5行是基本行数，超出5行就添加）
'上面字典的item值是每个仓库的总个数
'所以RoundUp((d.Items(i) + 1) / 3, 0),就是该仓库需要用的行数,而加上最低行数限制。用max比较取一个最大值即可
For i = 0 To d.Count - 1
'd2的item就是key所需要的行数
d2(d.Keys(i)) = WorksheetFunction.max(WorksheetFunction.RoundUp((d.Items(i) + 1) / 3, 0), 5)
'd3的item就是key的起点行号
d3(d.Keys(i)) = n
'计数器n计算下一个的起点行号
m = d2(d.Keys(i))
n = n + m
Next i
'最后的n值减1肯定就我们所需要数组的总行数了
ReDim arr1(1 To n - 1, 1 To 14)
'规律循环赋值（万变不离其中的凑数）
For i = 2 To UBound(arr)
'统计循环点得仓库类别及该类别的个数
d1(arr(i, 1)) = d1(arr(i, 1)) + 1
'分析标题需要站一行数据,所以每一类仓库前面5行只能放下14个
'所以用D1的item值+1来判断是否超出15个,超出15就需要添加行数了
If d1(arr(i, 1)) + 1 > 15 Then
m = d3(arr(i, 1)) + 5 '超出5行的起点行号
n = d2(arr(i, 1)) - 5 '增加的行数
'用m,n来凑数达到行列变化
m = (d1(arr(i, 1)) - 15) Mod n + m
n = Int((d1(arr(i, 1)) - 15) / n) * 5
For j = 1 To 4
arr1(m, n + j) = arr(i, j)
Next j
'else下面的就不说了 , 和效果1基本一样
Else
m = d3(arr(i, 1)) + d1(arr(i, 1)) Mod 5
n = Int(d1(arr(i, 1)) / 5) * 5
For j = 1 To 4
arr1(d3(arr(i, 1)), j) = arr(1, j)
arr1(m, n + j) = arr(i, j)
Next j
End If
Next i
Range("F1").Resize(UBound(arr1), UBound(arr1, 2)) = arr1
End Sub 孙哥辛苦了 很给力啊 赞一个！ 谢谢分享 vba这样的思路用的比较少，函数倒是很常见 wcymiss 发表于 2012-1-13 09:10 static/image/common/back.gif
vba这样的思路用的比较少，函数倒是很常见
不断提高并且不断学习 学习，谢谢分享！
页:
[1]