【VBA字典数组201301班】C组-第一讲作业上交处

无聊的疯子

本贴为C组作业上交专用,其他组员勿入~~~
对于本次作业添加一个小要求,5道题中,必需有一题解法中使用 ReDim Preserve  
1、作业提交请用上传附件或直接跟帖方式，；
2、附件文件名或帖子标题按要求格式命名：组号-论坛ID,
       如：【VBA字典数组201301班】-C05-萧峰；
3、作业截止时间：2013-11-6 18:00；

xdragon

{:071:}交作业了

xdragon

1. Sub 作业二方法2()
   
2. Dim arr, brr(1 To 5, 1 To 4), i, j As Integer
   
3. With Sheets("2")
   
4. arr = .Range("B2:F12")
   
5. For Each i In arr
   
6.   'brr(i \ 100 Mod 5 + 1, i \ 500 * 2 + 1) = "<" & (i \ 100 + 1) * 100
   
7.   brr(i \ 100 Mod 5 + 1, i \ 500 * 2 + 2) = brr(i \ 100 Mod 5 + 1, i \ 500 * 2 + 2) + 1
   
8. Next
   
9. For j = 1 To 10
   
10.   brr((j - 1) Mod 5 + 1, (j \ 6) * 2 + 1) = "<" & j * 100
    
11. Next
    
12. .Range("H3:K3") = Array("条件", "个数", "条件", "个数")
    
13. .[h4].Resize(UBound(brr), 4) = brr
    
14. End With
    
15. End Sub

复制代码

优化了下，感觉1、3列的赋值还是另起一个循环比较好，这样这个循环只要运算10次。如果在一个循环里，arr里有多少值就要判断多少次，不如这样的省事。虽然看上去长了点

练习5的instr方法

1. Sub 作业五方法2()
   
2. Dim arr, crr, i, j As String
   
3. arr = Range("C9:G23")
   
4. For Each i In arr
   
5. If InStr(1, j, "," & i & ",") = 0 Then j = j & "," & i & ","
   
6. Next
   
7. crr = Split(Replace(Replace(j, ",,", "|"), ",", ""), "|")
   
8. Range("l8:l" & Range("L" & Rows.Count).End(3).Row).ClearContents
   
9. [l8].Resize(UBound(crr) + 1) = Application.Transpose(crr)
   
10. End Sub

复制代码

Sellby

1. <p>
   
2. Sub 作业一()
   
3.     Dim arr(), tempArr
   
4.     Dim i As Byte, x As Byte
   
5.     With Sheets("1")
   
6.         .Columns("b:d").ClearContents
   
7.         .Columns("b:d").NumberFormatLocal = "@"
   
8.         arr = .Range("a1").CurrentRegion.Value
   
9.         x = UBound(arr)
   
10.         ReDim Preserve arr(1 To x, 1 To 4)
    
11.         For i = 1 To x
    
12.             tempArr = Split(arr(i, 1), "*")
    
13.             arr(i, 2) = tempArr(0)
    
14.             arr(i, 3) = tempArr(1)
    
15.             arr(i, 4) = tempArr(2)
    
16.        Next i
    
17.        .Range("a1").Resize(x, 4) = arr
    
18.     End With
    
19. End Sub
    
20. 
    
21. Sub 作业二()
    
22.     Dim arr(), brr(1 To 6, 1 To 4)
    
23.     Dim  a
    
24.     With Sheets("2")
    
25.         arr = .Range("b2:f12").Value
    
26.         brr(1, 1) = "条件": brr(1, 2) = "个数"
    
27.         brr(1, 3) = "条件": brr(1, 4) = "个数"
    
28.         brr(2, 1) = "<100": brr(2, 3) = "<600"
    
29.         brr(3, 1) = "<200": brr(3, 3) = "<700"
    
30.         brr(4, 1) = "<300": brr(4, 3) = "<800"
    
31.         brr(5, 1) = "<400": brr(5, 3) = "<900"
    
32.         brr(6, 1) = "<500": brr(6, 3) = "<1000"
    
33.         For Each a In arr
    
34.             Select Case a
    
35.             Case Is < 100
    
36.                 brr(2, 2) = brr(2, 2) + 1
    
37.             Case Is < 200
    
38.                 brr(3, 2) = brr(3, 2) + 1
    
39.             Case Is < 300
    
40.                 brr(4, 2) = brr(4, 2) + 1
    
41.             Case Is < 400
    
42.                 brr(5, 2) = brr(5, 2) + 1
    
43.             Case Is < 500
    
44.                 brr(6, 2) = brr(6, 2) + 1
    
45.             Case Is < 600
    
46.                 brr(2, 4) = brr(2, 4) + 1
    
47.             Case Is < 700
    
48.                 brr(3, 4) = brr(3, 4) + 1
    
49.             Case Is < 800
    
50.                 brr(4, 4) = brr(4, 4) + 1
    
51.             Case Is < 900
    
52.                 brr(5, 4) = brr(5, 4) + 1
    
53.             Case Else
    
54.                 brr(6, 4) = brr(6, 4) + 1
    
55.             End Select
    
56.         Next
    
57.         .Range("h3").Resize(6, 4).ClearContents
    
58.         .Range("h3").Resize(6, 4) = brr
    
59.     End With
    
60. End Sub
    
61. 
    
62. Sub 作业三()
    
63.     Dim arr(), brr()
    
64.     Dim i As Byte, j As Byte, x As Byte, y As Byte
    
65.     Dim iMax As Double, iMin As Double, iAvg As Double, iSum As Double, a As Double
    
66.     With Sheets("3")
    
67.         arr = .Range("a2").CurrentRegion.Value
    
68.         x = UBound(arr): y = UBound(arr, 2)
    
69.         ReDim brr(1 To x, 1 To 5)
    
70.         brr(1, 1) = "序号"
    
71.         brr(1, 2) = "最大数"
    
72.         brr(1, 3) = "最小数"
    
73.         brr(1, 4) = "平均值"
    
74.         brr(1, 5) = "和"
    
75.         For i = 2 To x
    
76.             iMax = 0
    
77.             iMin = 1000
    
78.             iSum = 0
    
79.             brr(i, 1) = arr(i, 1)
    
80.             For j = 2 To y
    
81.                 a = arr(i, j)
    
82.                 iSum = iSum + a
    
83.                 If a > iMax Then iMax = a
    
84.                 If a < iMin Then iMin = a
    
85.             Next j
    
86.             brr(i, 2) = iMax
    
87.             brr(i, 3) = iMin
    
88.             brr(i, 4) = iSum / (y - 1)
    
89.             brr(i, 5) = iSum
    
90.         Next i
    
91.         .Range("i2").Resize(x, 5).ClearContents
    
92.         .Range("i2").Resize(x, 5) = brr
    
93.     End With
    
94. End Sub
    
95. 
    
96. Sub 作业四()
    
97.     Dim arr(), brr(), crr()
    
98.     Dim Str, uStr As String, i As Byte
    
99.    
    
100.     With Sheets("4")
     
101.         arr = .Range("c13:g27").Value
     
102.         ReDim brr(1 To 255)
     
103.         For Each Str In arr
     
104.             uStr = Asc(UCase(Str))
     
105.             If IsEmpty(brr(uStr)) Then
     
106.                 brr(uStr) = Str
     
107.                 i = i + 1
     
108.                 ReDim Preserve crr(1 To i)
     
109.                 crr(i) = Str
     
110.             End If
     
111.         Next
     
112.         
     
113.         .Range("c43").Resize(100).ClearContents
     
114.         .Range("c43").Resize(i) = Application.Transpose(crr)
     
115. 
     
116.     End With
     
117. End Sub
     
118. 
     
119. Sub 作业五()
     
120.     Dim arr(), brr(1 To 20), crr()
     
121.     Dim i As Byte
     
122.     Dim a
     
123.     With Sheets("5")
     
124.         arr = .Range("C9:G23").Value
     
125.         For Each a In arr
     
126.             If IsEmpty(brr(a)) Then
     
127.                 brr(a) = a
     
128.                 i = i + 1
     
129.                 ReDim Preserve crr(1 To i)
     
130.                 crr(i) = a
     
131.             End If
     
132.         Next
     
133.         .Range("l8").Resize(20).ClearContents
     
134.         .Range("l8").Resize(i) = Application.Transpose(crr)
     
135.     End With
     
136. End Sub</p><p> </p><p>Sub 作业四2()
     
137.     Dim arr(), brr(), crr()
     
138.     Dim Str, uStr As String, i As Byte
     
139.     With Sheets("4")
     
140.         arr = .Range("c13:g27").Value
     
141.         ReDim brr(1 To 255)
     
142.         For Each Str In arr
     
143.             If InStr(uStr, UCase(Str)) = 0 Then
     
144.                 uStr = uStr & "6" & UCase(Str)
     
145.                 i = i + 1
     
146.                 ReDim Preserve crr(1 To i)
     
147.                 crr(i) = Str
     
148.             End If
     
149.         Next
     
150.         
     
151.         .Range("c43").Resize(100).ClearContents
     
152.         .Range("c43").Resize(i) = Application.Transpose(crr)</p><p>    End With
     
153. End Sub</p><p> </p>

复制代码

hrpotter

C03-hrpotter

1. 
   
2. Sub 作业一()
   
3.     Dim i As Long, j As Long
   
4.     Dim arr(), brr() As String, crr() As String
   
5.     arr = Range("a1").CurrentRegion
   
6.     ReDim brr(1 To UBound(arr), 1 To 3)
   
7.     For i = 1 To UBound(arr)
   
8.         crr = Split(arr(i, 1), "*")
   
9.         For j = 1 To 3
   
10.             brr(i, j) = crr(j - 1)
    
11.         Next
    
12.     Next
    
13.     Range("b1").Resize(UBound(brr), 3).ClearContents
    
14.     Range("b1").Resize(UBound(brr), 3) = brr
    
15. End Sub
    
16. 
    
17. Sub 作业二()
    
18.     Dim i As Long, j As Long, k As Long, x As Long, y As Long
    
19.     Dim arr, brr(1 To 6, 1 To 4)
    
20.     arr = Range("b2:f12")
    
21.     brr(1, 1) = "条件"
    
22.     brr(1, 2) = "个数"
    
23.     brr(1, 3) = "条件"
    
24.     brr(1, 4) = "个数"
    
25.     For i = 2 To 6
    
26.         For j = 1 To 3 Step 2
    
27.             brr(i, j) = "<" & ((j - 1) * 250 + (i - 1) * 100)
    
28.         Next
    
29.     Next
    
30.     For i = 1 To UBound(arr)
    
31.         For j = 1 To UBound(arr, 2)
    
32.             k = Int(arr(i, j) / 100)
    
33.             y = k \ 5
    
34.             x = k Mod 5
    
35.             brr(x + 2, 2 + y * 2) = brr(x + 2, 2 + y * 2) + 1
    
36.         Next
    
37.     Next
    
38.     Range("h3").Resize(6, 4).ClearContents
    
39.     Range("h3").Resize(6, 4) = brr
    
40. End Sub
    
41. 
    
42. Sub 作业三()
    
43.     Dim arr, brr(1 To 12, 1 To 5)
    
44.     Dim i As Long, j As Long
    
45.     Dim 和, 平均值, 最大数, 最小数
    
46.     arr = Range("b3:f13")
    
47.     brr(1, 1) = "序号"
    
48.     brr(1, 2) = "最大数"
    
49.     brr(1, 3) = "最小数"
    
50.     brr(1, 4) = "平均数"
    
51.     brr(1, 5) = "和"
    
52.     For i = 1 To 11
    
53.         和 = 0
    
54.         最大数 = arr(i, 1)
    
55.         最小数 = arr(i, 1)
    
56.         For j = 1 To 5
    
57.             和 = 和 + arr(i, j)
    
58.             If arr(i, j) > 最大数 Then
    
59.                 最大数 = arr(i, j)
    
60.             ElseIf arr(i, j) < 最小数 Then
    
61.                 最小数 = arr(i, j)
    
62.             End If
    
63.         Next
    
64.         brr(i + 1, 1) = i
    
65.         brr(i + 1, 2) = 最大数
    
66.         brr(i + 1, 3) = 最小数
    
67.         brr(i + 1, 4) = 和 / 5
    
68.         brr(i + 1, 5) = 和
    
69.     Next
    
70.     Range("i2").Resize(12, 5).ClearContents
    
71.     Range("i2").Resize(12, 5) = brr
    
72. End Sub
    
73. 
    
74. Sub 作业四()
    
75.     Dim arr, brr(1 To 100, 1 To 1)
    
76.     Dim i As Long, j As Long, k As Long, s As String
    
77.     arr = Range("c13:g27")
    
78.     For j = 1 To UBound(arr, 2)
    
79.         For i = 1 To UBound(arr)
    
80.             If InStr(s, UCase(arr(i, j))) = 0 Then
    
81.                 k = k + 1
    
82.                 brr(k, 1) = arr(i, j)
    
83.                 s = s & UCase(arr(i, j))
    
84.             End If
    
85.         Next
    
86.     Next
    
87.     Range("c43:c100").ClearContents
    
88.     Range("c43").Resize(k, 1) = brr
    
89. End Sub
    
90. 
    
91. Sub 作业五()
    
92.     Dim arr, brr(1 To 100000), crr(1 To 100, 1 To 1)
    
93.     Dim i As Long, j As Long, k As Long
    
94.     arr = Range("c9:g23")
    
95.     For j = 1 To UBound(arr, 2)
    
96.         For i = 1 To UBound(arr)
    
97.             If brr(arr(i, j)) <> 1 Then
    
98.                 k = k + 1
    
99.                 crr(k, 1) = arr(i, j)
    
100.                 brr(arr(i, j)) = 1
     
101.             End If
     
102.         Next
     
103.     Next
     
104.     Range("l8:l34").ClearContents
     
105.     Range("l8").Resize(k) = crr
     
106. End Sub

复制代码

【VBA字典数组201301班】-C03-hrpotter.rar (64.54 KB, 下载次数: 6)

2013-11-3 09:17 上传

点击文件名下载附件

箫风

上交作业了，谢谢老师们！

monicaj

请审阅。。。

cxloen

谢谢首长

sayloveyou2010

笨熊猫