grf1973 发表于 2015-6-18 09:44
function加个去重的判断。
选择整列时没有数据输出。
Sub 去重复后用逗号合并单元() '选择整列时没有数据输出。
On Error Resume Next
Dim rng1 As Range, rng2 As Range
Set rng1 = Application.InputBox("请选择源区域", "温馨提示", , , , , , 8) '选择F:K列,试试。
Set rng2 = Application.InputBox("请选择存放区域", "温馨提示", , , , , , 8)
If rng1 Is Nothing Then MsgBox "请选择源区域": Exit Sub
If rng2 Is Nothing Then MsgBox "请选择存放区域": Exit Sub
rng2.Cells(1, 1).Resize(rng1.Rows.Count, 1) = ToJoin(rng1)
End Sub
Function ToJoin(Rng)
Dim arr, brr$(), i&, j&, ss$
arr = Rng
ReDim brr(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
ss = ","
For j = 1 To UBound(arr, 2)
If Not IsError(arr(i, j)) Then
If Len(arr(i, j)) > 0 And InStr(ss, "," & arr(i, j) & ",") = 0 Then ss = ss & arr(i, j) & ","
End If
Next
brr(i, 1) = Mid(ss, 2, Len(ss) - 2) '去掉首尾逗号
Next
If i = 2 Then
ToJoin = brr(i, 1)
Else
ToJoin = brr ' 数组形式,引用所有区域后三键结束!
End If
End Function
|