Question

我需要运行一个报告，该报告根据母版表中的列值将数据拆分为多个表，然后在母版表的单独选项卡中汇总列值的计数。

到目前为止，我只能根据唯一列值拆分数据

编号姓氏类别日期原因mgr id mgr电子邮件有效部门部门代码服务/部门 54968测试名称1 FIFA 2018年8月19日符合G 76047 test1@gmail.com是yoyo t1 Team1服务

54968测试名称2 FIFA 20/08/2018适用于g 76048 test1@gmail.com是yoyo t1-abcd Team1 Service-abcd支持

54968测试名称3 FIFA 2018年8月21日符合G 76049 test1@gmail.com是yoyo t1-fdgc Team1 Service-fdgc支持

54968测试名称4 FIFA 22/08/2018对g 76050 test1@gmail.com良好yoyo t2 Team2服务

54969测试名称5 FIFA 2018年8月23日符合G 76051 test1@gmail.com是yoyo t2-abcd Team2 Service-fdgc支持

是否有一种方法可以修改vba，以将工作表1中的所有工作组1信息分组为新工作表的名称为“工作组1”，以此类推，其他工作组也是如此（例如，包含Team1 Service，Team1 Service-abcd，Team1将service-dcef分成1张），而不是为每个值创建不同的张？

然后我如何使它计算拆分结束时进入“摘要”选项卡的每一列的行数？例如：

服务总额

Team1 3

Team2 2

以下Vba代码：

Sub ExtractToNewWorkbook()

Dim ws     As Worksheet

Dim wsNew  As Workbook

Dim rData  As Range

Dim rfl    As Range
Dim p      As Range

Dim state  As String

Dim sfilename As String

Set ws = ThisWorkbook.Sheets("Sheet1")


With ws

Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 12).End(xlUp))

.Columns(.Columns.Count).Clear

.Range(.Cells(2, 12), .Cells(.Rows.Count, 12).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True


For Each rfl In .Range(.Cells(1, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp))

sectioncode = rfl.Text



Set wsNew = Workbooks.Add

sfilename = sectioncode & ".xlsx"


ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sfilename

Application.DisplayAlerts = False

ws.Activate

rData.AutoFilter Field:=12, Criteria1:=sectioncode

rData.Copy

Windows(sectioncode).Activate

ActiveSheet.Paste

ActiveWorkbook.Close SaveChanges:=True

Next rfl

Application.DisplayAlerts = True

End With

ws.Columns(Columns.Count).ClearContents

rData.AutoFilter

End Sub

代码根据包含“-”的列将工作表拆分为多个工作簿，并计算要在“摘要”选项卡中显示的行数

0 个答案: