V中第02讲(01号-22号)作业上交贴

被禁锢的风 · 发表于 2012-1-20 13:50

本帖最后由被禁锢的风于 2012-2-15 20:45 编辑

第02讲作业地址：
http://www.excelpx.com/thread-220540-1-1.html

注意：
1、非01号-22号号学员，不得交于此处，不得为抢沙发而占位，不得跟灌水帖，违者扣分。
2、上交的作业EXCEL 文件名按第一讲作业-学号-班级ID 的格式保存后上传（如“第01讲作业-27-fjmxwrs）。
3、代码请尽量编写注释，方便批改也方便其他同学学习程序思路。

作业上交截止日：
2月3日（周五） 18:00前上交的作业将得到批改
2月5日（周六）18:00前上交的作业只统计上交，不做批改。

windimi007 · 发表于 2012-1-20 13:54

【V中2.05】windimi007前来交作业！{:3512:}
不知道是不是沙发呢？{:3912:}

9lee · 发表于 2012-1-20 14:15

交了作业好过年
辛苦风老师

第二讲作业-08-9lee.rar (22.59 KB, 下载次数: 27)

liuts · 发表于 2012-1-20 14:39

Sub salary()
Dim t
t = Timer
Dim arr, title, coefficient, dic As New Dictionary, i%, j%, k%
With Sheets("工资标准")
title = .Range("a1").CurrentRegion.Value '读入职称工资数组
coefficient = .Range("d1").CurrentRegion.Value '读入岗位系数数组
k = .UsedRange.Rows.Count
For i = 1 To k
'通过循环　放入字典　从而建立索引表
dic(title(i, 1)) = title(i, 2)
dic(coefficient(i, 1)) = coefficient(i, 2)
Next
End With
With Sheets("人员工资表")
arr = .Range("a1").CurrentRegion.Value
For j = 2 To UBound(arr)
arr(j, 6) = dic(arr(j, 5)) * dic(arr(j, 4)) '调用索引，计算
Next
.Range("f2").Resize(UBound(arr) - 1).ClearContents '清空数据
.Range("A1").Resize(UBound(arr), UBound(arr, 2)) = arr '数据存入单元格
End With
MsgBox Timer - t
End Sub
Sub Crossq()
Dim t
t = Timer
Dim dic As New Dictionary, d As New Dictionary, dd As New Dictionary, arr, i%, j%, sr$, Ar(), brr(), Br
Dim rg As Range, k As Byte, s$
Dim d1 As New Dictionary, d2 As New Dictionary
arr = Sheets("人员工资表").Range("a1").CurrentRegion.Value '将工资表存入数组
Br = Application.Index(arr, 1, 0) '定义标题索引数组
For j = 1 To UBound(Br)
dd(Br(j)) = j '建立索引编号
Next
With Sheets("交叉表统计")
'利用字典，规范数据录入此处利用数组，更为简单　可直接字义一个两行两列数组
For Each rg In Union(.[d2:d3], .[g2:h2])
sr = rg.CurrentRegion.Range("a1").Value
If Not IsEmpty(rg.Value) And Not dic.Exists(sr) Then
dic.Add sr, Array(rg.Value)
k = k + 1
ElseIf rg.Value <> "" And dic.Exists(sr) Then
Ar = dic.Item(sr)
ReDim Preserve Ar(0 To UBound(Ar) + 1)
Ar(1) = rg.Value
dic.Item(sr) = Ar
k = k + 1
End If
If Not IsEmpty(rg.Value) And Not d.Exists(rg.Value) Then
d.Add rg.Value, dd(rg.Value)
d.Add dd(rg.Value), rg.Value
ElseIf d.Exists(rg.Value) Then
MsgBox "标题重复！": Exit Sub
End If
Next
If k <> 3 Then MsgBox "必须为３个条件": Exit Sub
纵列 = dic.Items(0) '读取纵列信息
横行 = dic.Items(1) '读取横行信息
dic.RemoveAll: k = 0 '清空字典，可重新定义一新变量
For i = 2 To UBound(arr)
'利用字典汇总特性，得出结果数据
If UBound(纵列) = 1 Then
sz = arr(i, dd(纵列(0))) & Chr(10) & arr(i, dd(纵列(1))) '此处写法只限于此题
sh = arr(i, dd(横行(0)))
Else
sh = arr(i, dd(横行(0))) & Chr(10) & arr(i, dd(横行(1)))
sz = arr(i, dd(纵列(0)))
End If
d1(sz) = "": d2(sh) = "" '生成行列标题
If Not dic.Exists(sz & sh) Then
dic(sz & sh) = arr(i, 6)
Else
dic(sz & sh) = arr(i, 6) + dic(sz & sh)
End If
Next
ReDim brr(0 To d1.Count, 0 To d2.Count) '生成结果数组样式
For i = 0 To UBound(brr) - 1
For j = 0 To UBound(brr, 2) - 1
'通过循环赋值
brr(i + 1, 0) = d1.Keys(i)
brr(0, j + 1) = d2.Keys(j)
brr(i + 1, j + 1) = dic(brr(i + 1, 0) & brr(0, j + 1))
Next j
Next i
.Range("c6:iv65536").ClearContents '清空数据
.Range("c6").Resize(UBound(brr) + 1, UBound(brr, 2) + 1) = brr '数据存入单元格
End With
MsgBox Timer - t
End Sub

复制代码

dongqing1998 · 发表于 2012-1-23 22:58

第02讲作业-02-dongqing1998.rar (32.48 KB, 下载次数: 45)

联乔 · 发表于 2012-1-27 09:40

第02讲作业-B17-联乔教师统计报表.rar (22.09 KB, 下载次数: 11)

wuxingai · 发表于 2012-1-27 10:02

本帖最后由 wuxingai 于 2012-2-17 19:44 编辑

第02讲作业-20-wuxingai.rar (20.61 KB, 下载次数: 21)

rxj_0414 · 发表于 2012-1-27 13:06

学委辛苦了。

第02讲作业-10-rxj_0414.rar (22.92 KB, 下载次数: 12)

sunjing-zxl · 发表于 2012-1-29 15:16

014:sunjing-zxl 上交作业

第02讲作业-14-sunjing-zxl.rar (25.16 KB, 下载次数: 21)

csmccdh · 发表于 2012-1-30 12:06

上交作业：

第02讲作业-06-csmccdh.rar (23.26 KB, 下载次数: 40)

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

[习题] V中第02讲(01号-22号)作业上交贴

评分

相关帖子