[接龙...]部分程序代码注释，目录更新20051222

Long_III · 发表于 2005-10-17 17:01

56、自定义函数的可选参数+多重条件模糊引用。 QJcfIRMB.rar (8.54 KB, 下载次数: 150)

代码：

Function H_Find(rng As Range, rng1 As Range, x1, Optional x2, Optional x3, Optional x4, Optional x5) As String Dim s As String '可选参数，共4个，x1是比选的 Dim i%

Application.Volatile '每次单元格改动时，都会自动更新这个自定义函数的值 With rng If rng.Count = 65536 Then H_Find = "ERROR": Exit Function '不要用整列做查找范围 For i = 1 To .Count If InStr(1, .Cells(i), x1) = 0 Then GoTo line1 '假如不包含x1这个条件的话，就直接调整到ling1行，就执行next循环

If Not IsMissing(x2) Then '假如自定义函数中使用了可选参数，则 If InStr(1, .Cells(i), x2) = 0 Then GoTo line1 '查看这个参数是否在单元格里出现，如果没有出现则跳到line1行 End If

If Not IsMissing(x3) Then '同上 If InStr(1, .Cells(i), x3) = 0 Then GoTo line1 End If

If Not IsMissing(x4) Then '同上 If InStr(1, .Cells(i), x4) = 0 Then GoTo line1 End If

If Not IsMissing(x5) Then '同上 If InStr(1, .Cells(i), x5) = 0 Then GoTo line1 End If

s = s & IIf(Len(s) = 0, "", ",") & rng1.Cells(i) '最终没有跳转就说明全部5个条件都符合，则链接到一个字符串s里面 line1: Next End With

H_Find = s '给自定义函数赋值 End Function

sunmon123 · 发表于 2005-10-17 18:37

太好，谢谢楼主，让我学到了不少的东西，我会常到这里看看的。

yangminnan · 发表于 2005-10-19 10:12

两位版主辛苦了。。

再谢。

阿拉拉 · 发表于 2005-10-19 20:37

[em06]

烟雨厦江南 · 发表于 2005-10-19 21:35

以下是引用Long_III在2005-8-10 13:38:54的发言：
to hzq56，用一个集合collection得到的，看代码h.Add arr1(i), CStr(arr1(i)) '用集合得到规格的不重复数据，由于集合里不能出现重复数据，在最前面加上On Error Resume Next，这样集合里就都不重复了，然后调用了工作表函数sumif，循环求得不重复值对应的合计值

不明白了，好象是On Error Resume Next这句不起作用

Long_III · 发表于 2005-10-21 09:40

57、简单的公式设置。忘了以前是否写过，但是经常看到类似的问题，主要是循环的一个起始、中止的判断。问题为“去悼一个最大值，再求平均数”。 PNhYSpo0.rar (12.71 KB, 下载次数: 133)

，代码：

Private Sub CommandButton1_Click() '按条件设置公式 Dim i%, irow%, m% Dim arr, aa Dim s As String

aa = Timer '记录开始时间 Application.ScreenUpdating = False '关闭屏幕更新 irow = [d65536].End(xlUp).Row 'd列的最后一行 arr = Range("d3:d" & irow) '简单的数组，相对可以提速一点点，也可以不用数组，直接根据单元格做 m = 3 '起始位置 For i = 3 To irow '在所有行里做一个循环 If arr(i - 2, 1) = "A" Then '假设单元格里为A的话，就设置公式 s = "e" & m & ":e" & i - 1 '可以说是一个范围，从m（起始位置）到i－1（中止位置） Cells(i, "e") = "=(sum(" & s & ")-max(" & s & "))/(count(" & s & ")-1)" '这部分就要根据公式的设置来连接了 Cells(i, "e").Copy Cells(i, "e").Resize(1, 9) '把这个公式复制到它后面的9个单元格里 m = i + 1 '判断下一次的起始位置 End If Next Application.ScreenUpdating = True '恢复系统设置 MsgBox "一次搞定！耗时：＝" & Format(Timer - aa, "0.00") & "秒" '计算程序运行的总时间 End Sub

DZY7252 · 发表于 2005-10-22 13:47

看了这些贴,才知道自己的EXCEL用的是多么的差啊! 全部收了.建议做个合集

npixxf · 发表于 2005-10-26 17:05

沒有被刪掉啊,只是選中了所有的空行而已!

Long_III · 发表于 2005-10-27 13:18

58、字典（dictionary）的应用。搜索了论坛，关于这个的介绍也很少，先前的一个例子http://club.excelhome.net/dispbb ... p;skin=0&page=1 40楼，让我意识到了它的功能的强大，故模仿做了一个简单例子，希望大家对它的应用有点了解。 3kBKAvkc.rar (13.56 KB, 下载次数: 177)

思路是，先把原始数据放到字典里，然后对要查找的数据在字典里查找，找到之后就赋值给新数组

Sub 按钮1_单击() Dim ds As Scripting.Dictionary '需要引用microsoft scripting runtime Dim irow%, irow1%, i%, k%, s Dim arr, arr1, Xarr()

Application.ScreenUpdating = False irow = [k65536].End(xlUp).Row 'K列赋值给数组arr arr = Range("k2:k" & irow) Set ds = New Scripting.Dictionary '建立一个新的字典，功能比collection集合更强大

On Error Resume Next '防止增加到字典里的数据有重复的 For i = 1 To UBound(arr) ds.Add Sort_Number(arr(i, 1)), i '调用自定义函数Sort_Number，用排序之后的值，增加进字典 Next Err.Clear On Error GoTo 0

irow1 = [l65536].End(xlUp).Row '对L列赋值给数组arr1 arr1 = Range("l2:l" & irow1)

For i = 1 To UBound(arr1) s = Sort_Number(arr1(i, 1)) '用排序之后的值查找 temp = "" temp = ds(s) '在字典中查找这个值 If temp <> "" Then '找到后，增加到新数组里 k = k + 1 ReDim Preserve Xarr(0, 1 To k) '定义了一个动态增加的数组 Xarr(0, k) = arr1(i, 1) End If Next Range("o").ClearContents '删除o列的数据 [o2].Resize(k, 1) = Application.WorksheetFunction.Transpose(Xarr) '给单元格赋值 Application.ScreenUpdating = True End Sub

链接贴：分享Microsoft Windows Script 技术对象之Dictionary对象说解http://www.officefans.net/cdb/vi ... id=hyo6Q9#pid376197

[此贴子已经被作者于2005-11-16 13:33:38编辑过]

plxmm · 发表于 2005-10-27 13:31

关于“dictionary”，Long_iii 等 GG们讨论得热火朝天。先学习了。[em24][em23]

		自动登录	找回密码
密码			免费注册