【字典201201班】B组（B01—B22）第1讲作业上交贴

7777

B15:7777
最近比较忙，这么晚了还做作业，希望老师谅解，麻烦改下！！
昨晚1点交的作业，早上起来想了想，好像有点漏洞，再修改下。
Sub aa() '作业代码写在该模块
  Dim D As New Dictionary
Dim I As Integer
Dim ARR
ARR = Range("A2：C111")
For I = 1 To UBound(ARR)
If ARR(I, 2) = Range("G1") Then
D(ARR(I, 1)) = D(ARR(I, 1)) + ARR(I, 3)
End If
Next
Range("F3：G15").ClearContents
Range("F3").Resize(D.Count, 1) = Application.WorksheetFunction.Transpose(D.Keys)
Range("G3").Resize(D.Count, 1) = Application.WorksheetFunction.Transpose(D.Items)
D.RemoveAll
End Sub

7777

用事件来完成：
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim D As New Dictionary
Dim I As Integer
Dim ARR
ARR = Range("A2：C111")
For I = 1 To UBound(ARR, 1)
If ARR(I, 2) = Range("G1") Then
D(ARR(I, 1)) = D(ARR(I, 1)) + ARR(I, 3)
End If
Next
Range("F3：G15").ClearContents
Range("F3").Resize(D.Count, 1) = Application.WorksheetFunction.Transpose(D.Keys)
Range("G3").Resize(D.Count, 1) = Application.WorksheetFunction.Transpose(D.Items)
D.RemoveAll
   
End Sub