[讨论][求助]如何按条件连接字符串，并加入参数说明。

northwolves

Function LinkSamePro$(ByVal proin As Range, ByVal pro As Range, ByVal valueC As Range)
Dim rg As Range, x() As String, i As Integer
For Each rg In proin
If rg.Text = pro.Text Then
i = i + 1
ReDim Preserve x(1 To i)
x(i) = valueC(i, 1)
End If
Next
LinkSamePro = Join(x, "*")
End Function

C2=linksamepro(A$2:A$5,A2,B$2:B$5)

将B列数据复制到SHEET2,则:

C2=linksamepro(A$2:A$5,A2,Sheet2!B$2:B$5)

Kelidai

谢谢楼上的两位，下载后慢慢学习。

Kelidai

经过一夜的学习，发现如果能将pro的属性改为string(如sumif()的条件一样）,但又不知道如何用VBA修改代码。这样的话应用范围就更大了，就象文本的sumif()了。

[此贴子已经被作者于2006-3-24 13:45:46编辑过]

qee用

Function LinkSamePro4$(ByVal proIN As Range, ByVal pro As String, ByVal proOfs As Range)
Dim rg As Range
Dim i%
i = 0
For Each rg In proIN
If rg.Text = pro Then
LinkSamePro4 = LinkSamePro4 & "*" & proOfs.Cells(1).Offset(i, 0).Text
End If
i = i + 1
Next rg
LinkSamePro4 = Mid$(LinkSamePro4, 2)
End Function

有疑问就继续吧.

Kelidai

谢谢，我还真不甘心，如果将产品换成时间，我试了一下公式好象不行。

我的用法是这样的

=linksamepro4($B$2:$B$6,">"&B5,$C$2:$C$6)

说明：将确认日期大于3/20/2006的交期字符串连起来，数据很多。 uP7XbFJA.zip (6.7 KB, 下载次数: 40)

2006-3-24 14:57 上传

点击文件名下载附件

再问，如何加上象EXCEL自带函数一样的说明，那就更棒了。

[此贴子已经被作者于2006-3-24 15:22:19编辑过]

qee用

不仅比较方式复杂了,连数据类型也变复杂了,以后有时间再帮你补上.

Kelidai

谢谢QEE用。我已经很感激了，刚开始是想解决问题，后面的就是完善函数了，我也会继续学习，争取做一个文本的linkif(),哈哈！

qee用

[LinkIf讨论稿]
Option Explicit
'****************************************************************
'* 函数名:LinkIf
'* 功能:条件连接字符串,类似于数值内置函数SumIf
'* 参数: rgCriteria 必选,计算条件的区域
'* Criteria 必选,连接条件
'* rgLink 可选,需要连接字符串所在区域,默认为rgCriteria
'* lnkString 可选,连接符,默认为直接连接
'* 错误: 计算出错时返回#N/A
'*****************************************************************
Function LinkIf$(ByVal rgCriteria As Range, ByVal Criteria As String, Optional ByVal rgLink As Range = Nothing, Optional ByVal lnkString As String = "")
On Error GoTo Errs
Dim i%, blLink As Boolean, rg As Range, hdo$, Crt As Variant
If rgLink Is Nothing Then Set rgLink = rgCriteria
If Criteria Like "=*" Then
hdo = "="
Criteria = Mid$(Criteria, 2)
ElseIf Criteria Like "<>*" Then
hdo = "<>"
Criteria = Mid$(Criteria, 3)
ElseIf Criteria Like "<=*" Then
hdo = "<="
Criteria = Mid$(Criteria, 3)
ElseIf Criteria Like ">=*" Then
hdo = ">="
Criteria = Mid$(Criteria, 3)
ElseIf Criteria Like ">*" Then
hdo = ">"
Criteria = Mid$(Criteria, 2)
ElseIf Criteria Like "<*" Then
hdo = "<"
Criteria = Mid$(Criteria, 2)
Else
hdo = "="
End If
i = 0
For Each rg In rgCriteria
If (IsNumeric(rg) Or IsDate(rg)) And IsNumeric(Crt) And TypeName(rg.Value) <> "String" Then
Crt = Val(Criteria)
Else
Crt = Criteria
End If
Select Case hdo
Case "="
blLink = (rg = Crt)
Case "<>"
blLink = (rg <> Crt)
Case ">="
blLink = (rg >= Crt)
Case "<="
blLink = (rg <= Crt)
Case ">"
blLink = (rg > Crt)
Case "<"
blLink = (rg < Crt)
End Select
If blLink Then LinkIf = LinkIf & lnkString & rgLink.Cells(1).Offset(i, 0).Text
i = i + 1
Next rg
LinkIf = Mid$(LinkIf, Len(lnkString) + 1)
Exit Function
Errs:
Err.Clear
LinkIf = "#N/A"
End Function

Kelidai

很好，我想再加一句：if rgCriteria.Rows.Count>1做一个判断就更好。

这样就可以按行和列引用了。 Function LinkIf$(ByVal rgCriteria As Range, ByVal Criteria As String, Optional ByVal rgLink As Range = Nothing, Optional ByVal lnkString As String = "") On Error GoTo Errs Dim I%, blLink As Boolean, rg As Range, hdo$, Crt As Variant If rgLink Is Nothing Then Set rgLink = rgCriteria If Criteria Like "=*" Then hdo = "=" Criteria = Mid$(Criteria, 2) ElseIf Criteria Like "<>*" Then hdo = "<>" Criteria = Mid$(Criteria, 3) ElseIf Criteria Like "<=*" Then hdo = "<=" Criteria = Mid$(Criteria, 3) ElseIf Criteria Like ">=*" Then hdo = ">=" Criteria = Mid$(Criteria, 3) ElseIf Criteria Like ">*" Then hdo = ">" Criteria = Mid$(Criteria, 2) ElseIf Criteria Like "<*" Then hdo = "<" Criteria = Mid$(Criteria, 2) Else hdo = "=" End If I = 0 If rgCriteria.Rows.Count > 1 Then For Each rg In rgCriteria If (IsNumeric(rg) Or IsDate(rg)) And IsNumeric(Crt) And TypeName(rg.Value) <> "String" Then Crt = Val(Criteria) Else Crt = Criteria End If Select Case hdo Case "=" blLink = (rg = Crt) Case "<>" blLink = (rg <> Crt) Case ">=" blLink = (rg >= Crt) Case "<=" blLink = (rg <= Crt) Case ">" blLink = (rg > Crt) Case "<" blLink = (rg < Crt) End Select If blLink Then LinkIf = LinkIf & lnkString & rgLink.Cells(1).Offset(I, 0).Text I = I + 1 Next rg Else For Each rg In rgCriteria If (IsNumeric(rg) Or IsDate(rg)) And IsNumeric(Crt) And TypeName(rg.Value) <> "String" Then Crt = Val(Criteria) Else Crt = Criteria End If Select Case hdo Case "=" blLink = (rg = Crt) Case "<>" blLink = (rg <> Crt) Case ">=" blLink = (rg >= Crt) Case "<=" blLink = (rg <= Crt) Case ">" blLink = (rg > Crt) Case "<" blLink = (rg < Crt) End Select If blLink Then LinkIf = LinkIf & lnkString & rgLink.Cells(1).Offset(0, I).Text I = I + 1 Next rg End If LinkIf = Mid$(LinkIf, Len(lnkString) + 1) Exit Function Errs: Err.Clear LinkIf = "#N/A" End Function

[此贴子已经被作者于2006-3-30 13:06:43编辑过]

Kelidai

我还从其它资料中，找到了给自定义函数增加参数说明的方法与大家共享，请参考附件。 3xOUNNec.zip (13.34 KB, 下载次数: 149)

2006-3-30 17:01 上传

点击文件名下载附件
[求助]如何按条件连接字符串。