原帖由 excelflower 于 2010-12-30 11:47 发表 
你这不扯呢吗？直接step 2呀
不是又要建立一个循环吗？现传上代码和附件，请老师更正！
在下面程序中如何用粉红色语句部分取代砖红色语句部分？即如何用brr(2 * (Int((m) / 2)), r) 取得数组brr的4，6，8，10偶数行数组：具体要求见附件问题三：
漏报分类统计123.rar
(28.18 KB, 下载次数: 6)
Sub justtest4() '问题三
Dim dic, arr, i&, j&, k&, t&, m&, n&, x&, y&, arrt(), arrre(), brr()
Set dic = CreateObject("scripting.dictionary")
t = Sheet1.Cells(Rows.Count, "f").End(3).Row - 3
arr = Sheet1.Cells(4, "b").Resize(t, 20).Value
For i = 1 To t '
If dic.exists(arr(i, 1)) Then
j = dic(arr(i, 1))
arrt(2, j) = arrt(2, j) + 1 '统计各单位抽查的例数
If arr(i, 14) <> "" Then arrt(3, j) = arrt(3, j) + 1 '如果不及时
If arr(i, 17) <> "" Then arrt(4, j) = arrt(4, j) + 1 '如果是抽查
If arr(i, 18) <> "" Then arrt(5, j) = arrt(5, j) + 1 '如果不完整
If arr(i, 19) <> "" Then arrt(6, j) = arrt(6, j) + 1 '如果不准确
If arr(i, 20) <> "" Then arrt(7, j) = arrt(7, j) + 1 '如果不一致
Else: k = k + 1: ReDim Preserve arrt(1 To 7, 1 To k + 1): dic.Add arr(i, 1), k '如果单位第一次出现，则
'添加到字典项目，同时汇总记录数组也扩展一位，同时定义动态数组，用来返回汇总数组：注意K标识位的运用
arrt(1, k) = arr(i, 1): arrt(2, k) = 1 '同时对该单位赋值，人数初始化1
'If arr(i, 17) = "" Then arrt(3, k) = 1 '如果该行单位抽查卡片为空，人数初始化1
If arr(i, 14) <> "" Then arrt(3, k) = 1: '如果不及时，人数初始化1
If arr(i, 17) <> "" Then arrt(4, k) = 1 '如果是抽查，人数初始化1
If arr(i, 18) <> "" Then arrt(5, k) = 1 '如果不完整，人数初始化1
If arr(i, 19) <> "" Then arrt(6, k) = 1 '如果不准确，人数初始化1
If arr(i, 20) <> "" Then arrt(7, k) = 1 '如果不一致，人数初始化1
End If
Next i '进入循环下一次
ReDim Preserve brr(1 To 10, 1 To k + 1):
For m = 2 To 10
For r = 1 To k '
brr(2 * (Int(m / 3)) + 3, r) = arrt(2, r) - arrt(Int(m / 3) + 4, r) '取得完整数、准确数、一致数、及时数
'brr(2 *(QUOTIENT(m，2)), r) = brr(2 * (Int(m / 3)) + 3, r) / arrt(2, r) * 100 '准确率
brr(2 * (Int((m) / 2)), r) = brr(2 * (Int(m / 3)) + 3, r) / arrt(2, r) * 100 '取得完整率、准确率、一致率、及时率
brr(2 * (Int(Rnd(m) * 5 + 1)), r) = brr(2 * (Int(m / 3)) + 3, r) / arrt(2, r) * 100 '准确率
brr(1, r) = arrt(1, r) '上报单位数
brr(2, r) = arrt(2, r) '抽卡数arrt(4, j)
' brr(3, r) = arrt(2, r) - arrt(5, r) '完整数
' brr(4, r) = brr(3, r) / arrt(2, r) * 100 '完整率或除以brr(2,r)
'brr(5, r) = arrt(2, r) - arrt(6, r) '准确数
'brr(6, r) = brr(5, r) / arrt(2, r) * 100 '准确率
'brr(7, r) = arrt(2, r) - arrt(7, r) '一致数
'brr(8, r) = brr(7, r) / arrt(2, r) * 100 '一致率
'brr(9, r) = arrt(2, r) - arrt(3, r) '及时上报数
'brr(10, r) = brr(9, r) / arrt(2, r) * 100 '及时率
Next r
Next m
Set dic = Nothing '清空字典内存
j = Int(k / 2) + IIf(k Mod 2, 1, 0) '返回依实际汇总格式的行数:IIf(k Mod 2, 1, 0) 如果是偶数取1否则取0
ReDim arrre(1 To j, 1 To 6) '定义汇总格式数组，与表格相符j*6的表格
For i = 1 To k Step 2 '在汇总数组中循环，STEP2是因为汇总格式为两列返回。
x = x + arrt(2, i) + arrt(2, i + 1) '累加总人数
y = y + arrt(3, i) + arrt(3, i + 1) '累加总漏人数:
m = (i + 1) / 2 '返回汇总数组对应的汇总格式数组arrre(m, t + 1)对应的列
For t = 0 To 3 Step 3 '因为一条记录三列，所以STEP3.只有两列，所以只循环两次
n = i + t / 3 '返回汇总格式数组对应的汇总数组的列数[这里因为一行有两条记录，所以为t/3返回0，1]
arrre(m, t + 1) = arrt(1, n): arrre(m, t + 2) = arrt(2, n) '对不需判断的直接赋值
If arrt(3, n) <> "" Then '对漏报人数进行判断，如果没有就对应第三列返回空，如果有，就进行百分比运算。
arrre(m, t + 3) = arrt(3, n) & "（" & Format(arrt(3, n) / arrt(2, n), "0.00%") & "）"
End If
Next t
Next i
With Sheet2
.Range("a25:j" & Rows.Count).ClearContents '清除数据，避免影响
.Cells(25, 1).Resize(j, 6) = arrre '对区域赋值汇总格式数组
.Cells(44, 1).Resize(UBound(brr, 2), 10) = Application.Transpose(brr) '对区域赋值汇总格式数组
With .Cells(j + 5, 4) '表尾的合计行。
.Value = "合计"
.Offset(0, 1).Value = x '表尾的合计行赋值。
.Offset(0, 2).Value = y
End With
.Activate
End With
MsgBox "统计结束."
End Sub
[ 本帖最后由 gwfzh 于 2010-12-30 13:30 编辑 ] |
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2010-12-30 10:48
楼主