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

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

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(., .)
         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

啥时间发的上交作业贴？没看到群里的通知，好在还不晚。

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

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

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

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

{:1_1:}学委辛苦了。

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

014:sunjing-zxl上交作业

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

上交作业：

页: [1] 2

Excel精英培训网's Archiver

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