【Excel VBA初级班】B组第六讲作业上交帖

1032446692

【Excel VBA初级班】第五讲作业注意事项：
      1、作业必需交完成的EXCEL文件；
      2、一楼一帖，发现原上交作业需要修改的，在原贴编辑，并标注编辑重传的时间；
      3、非V初班学委、班管、B组学员，不得交于此处，违者扣经验和 BB；
      4、不得为抢沙发而占位、不得跟灌水帖，违者扣经验和 BB；
      5、上交的作业EXCEL文件名按学号+论坛ID 的格式保存后上传（如"B100-1032446692"），格式不符者不予批改；
      6、满分奖励10BB，按上交作业的正确率排名前3位，额外奖励5、3、2个经验分。如多人正确率一致，按最后修改时间在先的排前面；
      7、特别优秀的，或多答案的回答的，由其他组学委或班管额外奖励BB或经验；
      8、请上传作业时，记得先杀毒。
作业上交截止日：2013年9月13日16:00

wp8680

B40:wp8680上交作业，请阅。

1. Sub 作业一()
   
2.     Dim arr, brr() As String, m%, n%
   
3.     arr = Sheets("1").Range("a1:a" & Sheets("1").Range("a" & Cells.Rows.Count).End(xlUp).Row)
   
4.     ReDim brr(1 To UBound(arr), 1 To 3)
   
5.     For m = 1 To UBound(arr)
   
6.         For n = 1 To 3
   
7.             brr(m, n) = Split(arr(m, 1), "*")(n - 1)
   
8.         Next n
   
9.     Next
   
10.     Sheets("1").Range("b1").Resize(UBound(brr), 3) = brr
    
11. End Sub
    
12. 
    
13. Sub 作业二()
    
14.     Dim arr, brr(1 To 5), crr(1 To 5), m%, n%, x%
    
15.     arr = Sheets("2").Range("b2").CurrentRegion
    
16.     For m = 1 To UBound(arr, 1)
    
17.         For n = 1 To UBound(arr, 2)
    
18.             x = Int(arr(m, n) / 100) + 1
    
19.             If x < 6 Then brr(x) = brr(x) + 1 Else crr(x - 5) = crr(x - 5) + 1
    
20.         Next n
    
21.     Next m
    
22.     Sheets("2").Range("i4").Resize(5, 1) = Application.WorksheetFunction.Transpose(brr)
    
23.     Sheets("2").Range("k4").Resize(5, 1) = Application.WorksheetFunction.Transpose(crr)
    
24. End Sub
    
25. 
    
26. Sub 作业三()
    
27.     Dim arr, brr(), m%, n%
    
28.     arr = Sheets("3").Range("a2").CurrentRegion
    
29.     ReDim brr(1 To UBound(arr) - 1, 1 To 4)
    
30.    
    
31.     For m = 2 To UBound(arr, 1)
    
32.     brr(m - 1, 1) = 0
    
33.     brr(m - 1, 2) = 9E+307
    
34.         For n = 2 To UBound(arr, 2)
    
35.             If arr(m, n) > brr(m - 1, 1) Then brr(m - 1, 1) = arr(m, n)
    
36.             If arr(m, n) < brr(m - 1, 2) Then brr(m - 1, 2) = arr(m, n)
    
37.             brr(m - 1, 4) = brr(m - 1, 4) + arr(m, n)
    
38.         Next n
    
39.         brr(m - 1, 3) = brr(m - 1, 4) / 4
    
40.     Next m
    
41.     Sheets("3").Range("j3").Resize(UBound(brr), 4) = brr
    
42. End Sub

复制代码

w2001pf

作业6 B26-W2001PF.rar (47.81 KB, 下载次数: 7)

2013-9-9 17:40 上传

点击文件名下载附件

chuanqi3

b28-chuanqi3         

Sub 一()
    Dim arr, i As Integer, s
    arr = Range("a1:a" & Cells(Rows.Count, 1).End(3).Row)
    ReDim brr(1 To UBound(arr), 1 To 3)
        For i = 1 To UBound(arr)
            s = Split(arr(i, 1), "*")
            brr(i, 1) = "'" & s(0)
            brr(i, 2) = "'" & s(1)
            brr(i, 3) = "'" & s(2)
        Next
    Range("b1").Resize(UBound(brr), 3) = brr
End Sub

Sub 二()
    Dim arr, i As Integer, j As Integer, m As Integer, n As Integer
    arr = Range("b2:f12")
        For m = 1 To 10
            For i = 1 To UBound(arr)
                For j = 1 To UBound(arr, 2)
                    If arr(i, j) / 100 < m And arr(i, j) / 100 >= m - 1 Then
                       n = n + 1
                    End If
                Next
            Next
           If m > 5 Then
              Cells(m - 2, 11) = n
           Else
              Cells(m + 3, 9) = n
           End If
           n = 0
        Next
End Sub

Sub 三()
    Dim arr, i%, s, j%, k%, n%, v%, mysum!, myave!
    arr = Range("b3:f13")
    ReDim brr(1 To UBound(arr), 1 To 4)
        For i = 1 To UBound(arr)
            For j = 1 To UBound(arr, 2)
                For k = 1 To UBound(arr, 2)
                    If arr(i, j) > arr(i, k) Then
                        s = arr(i, j)
                        arr(i, j) = arr(i, k)
                        arr(i, k) = s
                    End If
                Next
            Next
        brr(i, 1) = arr(i, 1)
        brr(i, 2) = arr(i, 5)
        Next
       For n = 1 To UBound(arr)
           For v = 1 To UBound(arr, 2)
               mysum = mysum + arr(n, v)
           Next
               myave = mysum / 5
           brr(n, 4) = mysum
           brr(n, 3) = myave
           mysum = 0
       Next
    Range("j3").Resize(UBound(brr), 4) = brr
End Sub

xhrys

谢谢老师  谢谢学委  

牙痒痒

作业忘在家里了，晕，急急忙忙的，就做了一题，家里做了两题。又荒废了
B27-牙痒痒.rar (29.19 KB, 下载次数: 1)

2013-9-13 16:10 上传

点击文件名下载附件

1032446692

———————————————作业上交时间截止————————————————————————