excel超强合并多个区域的内容（支持内存数组）

发表于 2016-9-7 01:32:35

excel自定义函数超强合并不连续选区内的单元格，代码如下，通过 =超强合并（分隔符，是否去重复，要合并的若干个选区）来完成，比如要合并A1:B9，C20:E:54中的所有有值的单元格的内容，并且用逗号连接，可以这样写
=超强合并（“，”，0, A1:B9，C20:E:54）

如果所选区域中有重复值，只需要对重复值合并一次的话，把第二参数由0改为1就行了。
=超强合并（“，”，1, A1:B9，C20:E:54）

所选区域支持内存数组。

当要去重复的时候，大小写字母和半角圆角的都会被判定为不重复的项。

Function 超强合并(sr As String, cf As Boolean, ParamArray args() As Variant) As Variant
'第一参数为自定义的分隔符，要用双引号引起来或者是直接引用单元格。不可忽略，必须书写，否则出错。
'第二参数为逻辑值，不可忽略，必须书写。如果为false，则会依次按先行后列的顺序合并所有不为空的单元格。第二参数如果为true,对于区域中有重复值的单元格，只会对重复值合并一次,区分大小字母写及半角圆角。
'第三参数为要合并的区域，可以是多个区域，也可以是单个的值，还可以是多区域与多个单值的混合。当第三参数中含有内存数组时，使用的时候要用CTRL+ALT+ENTER三键按下。
Application.Volatile True
'-------------------------------------以下是允许有重复值合并----------------------------------------------------------
If cf = False Then
Dim tmptext As Variant
tmptext = ""
For Each R In args
If IsArray(R) Then
For Each rr In R
If rr <> "" Then tmptext = tmptext & sr & rr
Next rr
Else
If R <> "" Then tmptext = tmptext & sr & R
End If
Next R
超强合并 = Mid(tmptext, Len(sr) + 1) '去掉开头多余分隔符
'------------------------------以上允许有重复值合并-----------------------------------------------------------------
'------------------------------以下不允许有重复值合并-----------------------------------------------------------------
Else
Dim d
Set d = CreateObject("Scripting.Dictionary")
' d.CompareMode = vbTextCompare '即文本比较模式，不区分大小写以及半角圆角。
d.CompareMode = vbBinaryCompare '即二进制比较，区分大小写以及半角圆角。
For Each R In args
If IsArray(R) Then
For Each rr In R
If rr <> "" Then d(CStr(rr)) = ""
Next rr
Else
If R <> "" Then d(CStr(R)) = ""
End If
Next R
超强合并 = Join(d.Keys, sr)
Set d = Nothing
End If
End Function

复制代码

也可以直接下载下面的附件，放在 C:\Documents and Settings\Administrator\Application Data\Microsoft\AddIns这个文件夹里面。可能不同的系统不太一样，这个文件夹是office加载项文件存放的默认位置。可以在c盘搜索AddIns，得到该文件夹位置。
放在那儿后，直接在任何一个excel中把该文件加载上就可以了。
具体步骤是在菜单栏选择文件——选项——加载项——转到(G) ，然后就弹出了加载宏的对话框，然后把里面的 “超强多区域支持内存数组合并（终版）”前面打上勾，就可以了。

超强多区域支持内存数组合并：

超强多区域支持内存数组合并（终版）.xla (32.5 KB, 下载次数: 218)

帐号		自动登录	找回密码
密码			中文注册

[OFFICE] excel超强合并多个区域的内容（支持内存数组）