Excel怎样快速根据重复字段合并其它列数据
来源:网络收集 点击: 时间:2024-04-18首先打开Microsoft Office Excel 2007,新建文档并保存文件名《Excel怎样快速根据重复字段合并其它列数据.xlsm》(演示文件,下面代码复制到能运行宏的工作簿都可以),如下图。

然后按下快捷键ALT+F11打开VBA(宏)编辑界面,然后点菜单栏【插入】下拉中列表中点【模块(M)】如图。

然后插入了一个模块1,在代码框中复制如下代码:
Option Base 1
Sub 选数据根据重复字段合并()
2020-6-28 22:15:12
Dim i As Long, j As Long, n As Long, mn, mb, myr As Range
Dim r As Long, c As Long, k As Long, mc(), j1 As Long
mb = Selection
r = UBound(mb, 1)
c = UBound(mb, 2)
On Error Resume Next
With CreateObject(scripting.dictionary)
For i = 1 To r
.Add mb(i, 1), i
Next i
mn = .Keys
End With
ReDim mc(UBound(mn) + 1, c)
k = 0
For i = 0 To UBound(mn)
k = k + 1
mc(k, 1) = mn(i)
For j = 2 To c
n = 0
For j1 = 1 To r
If mn(i) = mb(j1, 1) Then
n = n + 1
If n = 1 Then
mc(k, j) = mb(j1, j)
Else
mc(k, j) = mc(k, j) , mb(j1, j)
End If
End If
Next j1
Next j
Next i
Set myr = Application.InputBox(prompt:=选择输出数据一个单元格, Type:=8)
myr.Resize(UBound(mn) + 1, c) = mc
End Sub

以上操作动态过程如下:

回到工作表窗口,首先选原数据表,然后运行【选数据根据重复字段合并】宏(菜单栏中点【视图】中下列表中【宏】列表【查看宏(V)】打开宏对方框,选该宏名,执行),提示“选择输出数据一个单元格”,选好后输出结果,运行过程如下图。


上面是“,”分隔,下面代码是换行代码:
Sub 选数据根据重复字段换行合并()
2020-6-28 22:25:12
Dim i As Long, j As Long, n As Long, mn, mb, myr As Range
Dim r As Long, c As Long, k As Long, mc(), j1 As Long
mb = Selection
r = UBound(mb, 1)
c = UBound(mb, 2)
On Error Resume Next
With CreateObject(scripting.dictionary)
For i = 1 To r
.Add mb(i, 1), i
Next i
mn = .Keys
End With
ReDim mc(UBound(mn) + 1, c)
k = 0
For i = 0 To UBound(mn)
k = k + 1
mc(k, 1) = mn(i)
For j = 2 To c
n = 0
For j1 = 1 To r
If mn(i) = mb(j1, 1) Then
n = n + 1
If n = 1 Then
mc(k, j) = mb(j1, j)
Else
mc(k, j) = mc(k, j) Chr(10) mb(j1, j)
End If
End If
Next j1
Next j
Next i
Set myr = Application.InputBox(prompt:=选择输出数据一个单元格, Type:=8)
myr.Resize(UBound(mn) + 1, c) = mc
End Sub
以上代码单独时要加上下面一句。
Option Base 1

宏运行结果如下:


如果觉得这篇经验帮到了您,请点击下方的 “投票点赞 或者“收藏”支持我!还有疑问的话可以点击下方的 “我有疑问”,谢谢啦!
注意事项动态图片要双击成单独大图才能播放全过程。
多行合并数据相同列数据合并EXCELVBA版权声明:
1、本文系转载,版权归原作者所有,旨在传递信息,不代表看本站的观点和立场。
2、本站仅提供信息发布平台,不承担相关法律责任。
3、若侵犯您的版权或隐私,请联系本站管理员删除。
4、文章链接:http://www.1haoku.cn/art_537781.html