自定义函数练习2:多表取唯一值和多表汇总

兰色幻想

<p>&nbsp;用一般的数组公式,进行多表返回唯一值和汇总计算时, 公式要非常复杂才行.</p><p>&nbsp;用VBA怎么编写呢? 大家试一下吧,做好的把代码贴上来吧.看谁的最简单</p><p>&nbsp; </p> x9akfjPR.rar (4.97 KB, 下载次数: 109)

2008-1-19 19:32 上传

点击文件名下载附件
[自定义函数练习]:多表取唯一值和多表汇总 <br/>

[此贴子已经被作者于2008-1-19 19:36:16编辑过]

zjxia889

<p>Function myone(n As Long) As String<br/>Dim d As New Dictionary<br/>Dim arr<br/>Dim k As Long<br/>Dim shc%<br/>For shc = 1 To Sheets.Count<br/>&nbsp;With Sheets(shc)<br/>&nbsp; If .name &lt;&gt; ActiveSheet.name Then<br/>&nbsp;&nbsp;&nbsp;&nbsp; arr = .Range(.Cells(2, 1), .Cells(.Range("A65536").End(xlUp).Row, 2)).Value<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For k = 1 To UBound(arr)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; d(arr(k, 1)) = ""<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next k<br/>&nbsp; End If<br/>&nbsp;End With<br/>&nbsp;Erase arr<br/>Next shc<br/>arr = Application.Transpose(d.Keys)<br/>d.RemoveAll<br/>For k = LBound(arr) To UBound(arr)<br/>&nbsp; d(k) = arr(k, 1)<br/>Next k<br/>myone = d(n)<br/>End Function<br/>Function mysum(name As String) As Long<br/>Dim d As New Dictionary<br/>Dim arr<br/>Dim k As Long<br/>Dim shc%<br/>For shc = 1 To Sheets.Count<br/>&nbsp;With Sheets(shc)<br/>&nbsp; If .name &lt;&gt; ActiveSheet.name Then<br/>&nbsp;&nbsp;&nbsp;&nbsp; arr = .Range(.Cells(2, 1), .Cells(.Range("A65536").End(xlUp).Row, 2)).Value<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; For k = 1 To UBound(arr)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; If Not d.Exists(arr(k, 1)) Then<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; d(arr(k, 1)) = arr(k, 2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Else<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; d(arr(k, 1)) = d(arr(k, 1)) + arr(k, 2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; End If<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; Next k<br/>&nbsp; End If<br/>&nbsp;End With<br/>&nbsp;Erase arr<br/>Next shc</p><p>mysum = d(name)<br/>End Function</p>

[此贴子已经被作者于2008-1-19 20:53:09编辑过]

hhzjxss

<p>做做看!</p><p>用字典做了一个，但不知道怎么才能提取出来做也自定义函数！</p><p>Sub 提取_唯一值_字典法()<br/>&nbsp;&nbsp;&nbsp; Dim d As New Dictionary ''要引用一个控件：在“浏阳”里找到scrrun.dll文件，打开引用既可！<br/>&nbsp;&nbsp;&nbsp; Dim arr1, arr2, arr3, x%, y%, z%<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; arr1 = Sheet1.Range("a2:b6")<br/>&nbsp;&nbsp;&nbsp; arr2 = Sheet2.Range("a2:b6")<br/>&nbsp;&nbsp;&nbsp; arr3 = Sheet3.Range("a2:b6")<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; For x = 1 To UBound(arr1)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; d(arr1(x, 1)) = arr1(x, 2)<br/>&nbsp;&nbsp;&nbsp; Next x<br/>&nbsp;&nbsp;&nbsp; For y = 1 To UBound(arr2)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; d(arr2(y, 1)) = d(arr2(y, 1)) + arr2(y, 2) '将重复key的Item数据累加<br/>&nbsp;&nbsp;&nbsp; Next y<br/>&nbsp;&nbsp;&nbsp; For z = 1 To UBound(arr3)<br/>&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp; d(arr3(z, 1)) = d(arr3(z, 1)) + arr3(z, 2) '将重复key的Item数据累加<br/>&nbsp;&nbsp;&nbsp; Next z<br/>&nbsp;&nbsp;&nbsp; <br/>&nbsp;&nbsp;&nbsp; Sheet4.Range("a2").Resize(d.Count, 1) = Application.Transpose(d.Keys)<br/>&nbsp;&nbsp;&nbsp; Sheet4.Range("b2").Resize(d.Count, 1) = Application.Transpose(d.Items)<br/>End Sub<br/></p>

[此贴子已经被作者于2008-1-19 22:57:40编辑过]

jianzh

<p>下了看会不会做</p>

GB16888

下载

akabuta

<p>练习</p>

youke333

占地~

zjxia889

如果名称为数值,mysum统计不了?

laosanjie

先下载练习看看。

guideming

<p>下载看看</p><p></p>