Код для разделения листа на несколько рабочих книг на основе столбца, содержащего «-», и подсчета количества строк, отображаемых на вкладке сводки - PullRequest
Новая
       10

Код для разделения листа на несколько рабочих книг на основе столбца, содержащего «-», и подсчета количества строк, отображаемых на вкладке сводки

0 голосов
/ 03 сентября 2018

Мне нужно запустить отчет, который разбивает данные на основе значения столбца в мастер-листе на несколько листов, а затем суммирует количество значений столбца на отдельной вкладке в мастер-листе.

Пока мне удалось разделить данные только по уникальным значениям столбца

Номер Фамилия Имя Имя Категория Дата Причина mgr id mgr email Действительный отдел Код отдела Сервис / Раздел 54968 test name1 fifa 19/08/2018 good to g 76047 test1@gmail.com Y yoyo t1 Team1 Service

54968 test name2 fifa 20/08/2018 good to g 76048 test1@gmail.com Yoyo t1-abcd Team1 Служба поддержки abcd

54968 test name3 fifa 21/08/2018 good to g 76049 test1@gmail.com Yoyo t1-fdgc Team1 Service-fdgc Support

54968 test name4 fifa 22/08/2018 good to g 76050 test1@gmail.com Yoyo t2 Team2 Service

54969 test name5 fifa 23/08/2018 good to g 76051 test1@gmail.com Yoyo t2-abcd Team2 Service-fdgc Support

Есть ли способ изменить vba, чтобы сгруппировать всю информацию о Team1 на 1 листе, указав Team 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
...