怎么把同一个表格里的数据，按名字，一个名字，整理成一个表格

zeche457 · 发表于 2021-10-1 10:53

怎么把同一个表格里的数据，按名字，一个名字整理成一个表格，谢谢

鄂龙蒙 · 发表于 2021-10-1 11:14

按A列《寄件人姓名》拆分？

zeche457 · 发表于 2021-10-1 11:29

鄂龙蒙发表于 2021-10-1 11:14
按A列《寄件人姓名》拆分？

是的，按A列《寄件人姓名》拆分

zeche457 · 发表于 2021-10-1 11:33

按A列《寄件人姓名》拆分，然后一个EXCEL 一个名字来分开来

xiangbaoan · 发表于 2021-10-1 12:13

Sub test()
Dim Dict As Object, ar, i As Long, j As Long, p As Long, c As Long, sh As Worksheet
DoApp False
For Each sh In Worksheets
If sh.Name <> "列表" Then sh.Delete
Next
Set Dict = CreateObject("Scripting.Dictionary")
ar = Worksheets(1).Range("A1").CurrentRegion
ReDim br(1 To UBound(ar), 1 To UBound(ar, 2))
For j = 1 To UBound(ar, 2)
br(1, j) = ar(1, j)
Next
p = 1 '以第1列为拆分依据
For i = 2 To UBound(ar)
If Not Dict.Exists(ar(i, p)) Then Dict(ar(i, p)) = Dict.Count + 1
Next
ReDim cr(1 To Dict.Count, 1 To 2)
For i = 1 To Dict.Count
cr(i, 1) = 1
cr(i, 2) = br
Next
For i = 2 To UBound(ar)
c = Dict(ar(i, p))
cr(c, 1) = cr(c, 1) + 1
For j = 1 To UBound(ar, 2)
cr(c, 2)(cr(c, 1), j) = ar(i, j)
Next
Next
For i = 1 To Dict.Count
With Worksheets.Add(After:=Worksheets(Worksheets.Count))
.Name = cr(i, 2)(2, p)
.Range("A1").Resize(cr(i, 1), UBound(ar, 2)) = cr(i, 2)
.Columns.AutoFit
End With
Next
Worksheets(1).Activate
Set Dict = Nothing
DoApp
Beep
End Sub
Function DoApp(Optional b As Boolean = True)
With Application
.ScreenUpdating = b
.DisplayAlerts = b
If b Then .Calculation = -4105 Else .Calculation = -4135
End With
End Function

复制代码

xiangbaoan · 发表于 2021-10-1 12:18

仅参考.rar (126.89 KB, 下载次数: 13)

zeche457 · 发表于 2021-10-1 13:38

xiangbaoan 发表于 2021-10-1 12:18

能把里面分出来的表格，再分割成单独的一个EXCEL 吗？按寄件人姓名

xiangbaoan · 发表于 2021-10-1 14:09

zeche457 发表于 2021-10-1 13:38
能把里面分出来的表格，再分割成单独的一个EXCEL 吗？按寄件人姓名

明白两法参考.rar (132.15 KB, 下载次数: 22)

zeche457 · 发表于 2021-10-8 15:00

xiangbaoan 发表于 2021-10-1 14:09

太感谢了！！！！大神

xiangbaoan · 发表于 2021-10-8 16:17

zeche457 发表于 2021-10-8 15:00
太感谢了！！！！大神

我以为你假期玩忘了呢。

		自动登录	找回密码
密码			免费注册

[求助] 怎么把同一个表格里的数据，按名字，一个名字，整理成一个表格