[已解决]求助：条件如何修改？如何不出现重复值？

759857387 · 发表于 2011-7-1 22:02

看到的帖子：
自定义了一个HB函数供参考。
使用方法：在excel中按住ALT，依次按F11,I,M
将下面的代码粘贴在刚刚插入的模块中就可以在工作表中调用函数HB了。

Function HB(if_range, Optional criteria, Optional hb_range, Optional separator)
If IsMissing(separator) Then separator = " "
If IsMissing(hb_range) Then Set hb_range = if_range
If IsMissing(criteria) Then
      For Each c In hb_range.Cells
         t = t & separator & c
      Next
Else
      If Left(criteria, 1) = "F" Then
         For i = 1 To if_range.Cells.Count
            If InStr(if_range.Cells(i), Mid(criteria, 2)) Then t = t & separator & hb_range.Cells(i)
         Next i
      Else
         For i = 1 To if_range.Cells.Count
            If Application.Evaluate(if_range.Cells(i) & criteria) Then t = t & separator & hb_range.Cells(i)
         Next i
      End If
End If
HB = Mid(t, 2)
End Function

函数参数说明
HB(参数1,参数2,参数3,参数4)
参数1：查找区域。用来查找或与参数2进行比较的区域
参数2：条件。如果该参数省略，则直接合并参数1中的全部内容。如果该参数以F开头，则在参数1中查找F后所跟字符串。
参数3：当参数1符合参数2的条件时，要返回的内容。该区域大小必须与参数1一致。如果省略则等于参数1。
参数4：返回结果中的分隔符，如果省略则为空格。

用一个具体的实例来说明一下函数的用法。
假设A1:B11中有如下数据

姓名成绩
曹操 99
孙权 96
刘备 96
关羽 90
张飞 59
赵云 89
诸葛亮 100
周瑜 99
大乔 82
小乔 85

公式：=hb(A2:A11)
说明：将A2:A11区域的文本合并，使用默认分隔符空格
结果：曹操孙权刘备关羽张飞赵云诸葛亮周瑜大乔小乔

公式：=hb(A2:A11,,,"/")
说明：将A2:A1区域的文本合并，使用分隔符“/”
结果：曹操/孙权/刘备/关羽/张飞/赵云/诸葛亮/周瑜/大乔/小乔

公式：=hb(B2:B11,"=99",A2:A11)
说明：将B2:B11区域等于99的对应A2:A11区域合并，使用默认分隔符空格
结果：曹操周瑜

公式：=hb(B2:B11,">90",A2:A11,",")
说明：将B2:B11中大于90的对应A2:A11区域合并，使用分隔符“,”
结果：曹操,孙权,刘备,诸葛亮,周瑜

公式：=hb(A2:A11,"F乔")
说明：在A2:A11查找“乔”，返回合并结果，使用默认分隔符空格。
结果：大乔小乔
求修改公式：=hb(B2:B11,">90",A2:A11,",")中条件为>-0.1且<0.1
A2:A11如果出现重复，合并后最好不出现。
上面是其他网的帖子没有附件。
谢谢啦！

最佳答案

月排行榜 / 总排行榜

sunjing-zxl

2011-7-2 08:18

回复 759857387 的帖子

Function HB(if_range, Optional criteria, Optional hb_range, Optional separator)
Dim arr
Dim b As Long
If IsMissing(separator) Then separator = " "
If IsMissing(hb_range) Then Set hb_range = if_range
If IsMissing(criteria) Then
For Each c In hb_range.Cells
t = t & separator & c
Next
Else
If Left(criteria, 1) = "F" Then
For i = 1 To if_range.Cells.Count
If InStr(if_range.Cells(i), Mid(criteria, 2)) Then t = t & separator & hb_range.Cells(i)
Next i
Else
For i = 1 To if_range.Cells.Count
If Application.Evaluate(if_range.Cells(i) & criteria) Then t = t & separator & hb_range.Cells(i)
Next i
End If
End If
HB = Mid(t, 2)
arr = Split(HB, separator)
Set d = CreateObject("Scripting.Dictionary")
For b = 0 To UBound(arr)
If Not d.exists(arr(b)) Then d.Add arr(b), arr(b)
Next b
arr = d.Items
HB = Join(arr, separator)
End Function

复制代码

试一试这个

跳转到最佳答案楼层

759857387 · 发表于 2011-7-1 22:40

回复 759857387 的帖子

条件如何修改我已经解决了。
那位老师帮助解决——合并后不出现重复字符

沉默的闹钟 · 发表于 2011-7-1 22:51

来逛下！~！~！

sunjing-zxl · 发表于 2011-7-2 14:27

在哪里加什么样的超级链接，你的目的是什么。
我的QQ就在我每个帖子发言下面。

759857387 · 发表于 2011-7-2 10:29

回复 sunjing-zxl 的帖子

老师能否再完善一步？在不重复的基础上加超链接？
希望得到您的邮箱地址，我的感谢方式是给你实时股市买卖信号。

sunjing-zxl · 发表于 2011-7-2 08:18

这个最佳答案由 sunjing-zxl 给出，感谢 sunjing-zxl 的回答。

单击隐藏图章

回复 759857387 的帖子

Function HB(if_range, Optional criteria, Optional hb_range, Optional separator)
Dim arr
Dim b As Long
If IsMissing(separator) Then separator = " "
If IsMissing(hb_range) Then Set hb_range = if_range
If IsMissing(criteria) Then
For Each c In hb_range.Cells
t = t & separator & c
Next
Else
If Left(criteria, 1) = "F" Then
For i = 1 To if_range.Cells.Count
If InStr(if_range.Cells(i), Mid(criteria, 2)) Then t = t & separator & hb_range.Cells(i)
Next i
Else
For i = 1 To if_range.Cells.Count
If Application.Evaluate(if_range.Cells(i) & criteria) Then t = t & separator & hb_range.Cells(i)
Next i
End If
End If
HB = Mid(t, 2)
arr = Split(HB, separator)
Set d = CreateObject("Scripting.Dictionary")
For b = 0 To UBound(arr)
If Not d.exists(arr(b)) Then d.Add arr(b), arr(b)
Next b
arr = d.Items
HB = Join(arr, separator)
End Function

复制代码

试一试这个

wdkjs · 发表于 2011-7-4 17:06

学习学习！

759857387 · 发表于 2011-7-4 16:42

回复 sunjing-zxl 的帖子

今天在实测时，自己加的超链接公式没有成功，只好回到原来单一发送状态。
我需要在附件图中黄色单元格内字符串超链接，烦劳老师再修改一下上面那个函数，谢谢！
请告知我你的股票代码。

759857387 · 发表于 2011-7-5 22:49

回复 sunjing-zxl 的帖子

孙老师我今天上传了文件帮忙改一下，谢谢！
这两天一直在测试，基本没有怎么发送，没有让你看到效果见谅。

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