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

Kelidai

如何按条件连接字符串。
将相同条件的字符串连接起来。
具体要求见附件。 5s3PZIJo.zip (13.34 KB, 下载次数: 159)

2006-3-30 17:05 上传

点击文件名下载附件
[讨论][求助]如何按条件连接字符串，并加入参数说明。

有会员朋友提问,就想起了这个贴子.自定义函数加说明的方法加1分. qee用

[此贴子已经被qee用于2007-7-1 4:45:51编辑过]

james.wan

用VBA吧

Kelidai

怎么用？帮帮忙看一下？

可不可以做个函数

[此贴子已经被作者于2006-3-23 11:55:29编辑过]

蜜雪儿

Sub Mxr()
Dim n
Range("A1:B" & [A65536].End(xlUp).Row).Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal

For n = 2 To [A65536].End(xlUp).Row
If Cells(n, 1) = Cells(n + 1, 1) Then
Cells(n, 3) = Cells(n, 2) & "*" & Cells(n + 1, 2)
End If
Next
End Sub

qee用

[c2]=linksamepro(A2)
Function LinkSamePro$(ByVal pro As Range)
Dim rg As Range
For Each rg In Range("A1:A" & [a65535].End(xlUp).Row)
If rg.Text = pro.Text Then LinkSamePro = LinkSamePro & "*" & rg.Offset(0, 1).Text
Next rg
LinkSamePro = Mid$(LinkSamePro, 2)
End Function

Kelidai

谢谢楼上的两位。

qee用: 请问可不可这样引用：C2=linksamepro(A2:A5,A2,B2:B5),能不能再进一步改一下。 也就是在具体的范围内求结果。 热盼。

[此贴子已经被作者于2006-3-23 13:13:36编辑过]

northwolves

借用qee用兄弟的函数:

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

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

qee用

谢谢northwolves兄!
我现在是网通的用户,刷新一次届面就要几分钟.
刚才发了几次都没发出去.把你的要求修改一下可以吗?
[C2]=linksamepro2(A2:A5,A2,1)第三个参数表示偏移量
Function LinkSamePro2$(ByVal proIN As Range, ByVal pro As Range, ByVal ofs As Integer)
Dim rg As Range
For Each rg In proIN
If rg.Text = pro.Text Then LinkSamePro2 = LinkSamePro2 & "*" & rg.Offset(0, ofs).Text
Next rg
LinkSamePro2 = Mid$(LinkSamePro2, 2)
End Function

Kelidai

QEE和northwolves：你们好。

能不能将函数改成这样，如可以怎么改。

Function LinkSamePro2$(ByVal proIN As Range, ByVal pro As Range, ByVal valueC As Range )

不知可不可跨sheet表引用。

C2=linksamepro(A2:A5,A2,B2:B5); 就像SUMIF(range,criteria,sum_range)

不要嫌我烦啊，谢谢。

[此贴子已经被作者于2006-3-23 15:58:32编辑过]

qee用

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