Макрос, чтобы разделить данный файл на количество записей, определенных в диапазоне - PullRequest
0 голосов
/ 11 февраля 2020

У меня есть лист Excel под названием «Данные», в котором приведены образцы данных, которые выглядят как снимок экрана ниже.

enter image description here

Кроме того, у меня есть другой лист под названием «Настройки», в котором я даю значение диапазона (на какой частоте я хочу разделить данные), как показано ниже.

enter image description here

Мне нужно написать макрос, который разделит данные в листе «Данные», посмотрев на столбец «Supervisor ID», и разделит его в соответствии с диапазоном, определенным в листе настроек.

Например: если я определите Range = 2 на листе «Настройки», после чего данные на листе «Данные» должны быть разбиты на каждые 2 записи «Supervisor ID» на следующие рабочие книги ...

** Ожидается O / p: WB1 = строка с идентификатором супервизора 1 и 2

WB2 = строка с идентификатором супервизора 3 и 4,4,4

WB3 = строка с идентификатором супервизора 5 и 6

WB4 = строка с идентификатором супервизора 7,7 и 8

WB5 = строка с идентификатором супервизора 9 и 10,10 **

Примечание: Значение диапазона определяется на листе «Настройки» для поиска в столбце «Идентификатор супервизора» и разделения данных. Это НЕ делить данные вслепую на нет. столбцов.

Здесь, если идентификатор супервизора = "4" появляется 3 раза, то он должен быть таким, как показано ниже ...

WB2 = строка с идентификатором супервизора 3 и 4 , 4,4

Я написал макрос, в котором я предоставляю начальный номер и конечный номер, а затем разделяю данные ... , но я хочу разделить данные на давая диапазон, который в свою очередь смотрит на значение столбца «Supervisor ID» и делит его соответственно, как описано выше.

Пожалуйста, дайте мне знать, как изменить мой код для достижения этого требования изменения?

Option Explicit

Sub Split_Data_in_workbooks()

        Application.ScreenUpdating = False

        Dim data_sh As Worksheet
        Set data_sh = ThisWorkbook.Sheets("Data")

        Dim setting_Sh As Worksheet
        Set setting_Sh = ThisWorkbook.Sheets("Settings")

        Dim nwb As Workbook
        Dim nsh As Worksheet

        Dim FilePath As String
        FilePath = ""

        data_sh.AutoFilterMode = False

        Dim start_loc_num As Integer

        Dim end_loc_num As Integer

        Dim i As Integer

        For i = 2 To Application.CountA(setting_Sh.Range("A:A"))

            start_loc_num = setting_Sh.Range("A" & i).Value
            end_loc_num = setting_Sh.Range("B" & i).Value


            data_sh.UsedRange.AutoFilter Field:=2, Criteria1:=">=" & start_loc_num, Operator:=xlAnd, Criteria2:="<=" & end_loc_num

            Set nwb = Workbooks.Add
            Set nsh = nwb.Sheets(1)

            data_sh.UsedRange.SpecialCells(xlCellTypeVisible).Copy nsh.Range("A1")
            nsh.UsedRange.EntireColumn.ColumnWidth = 15


               On Error Resume Next

                    FilePath = Dir(setting_Sh.Range("H7").Value & "/Extract- " & start_loc_num & " to " & end_loc_num & ".xlsx")

               On Error GoTo 0

                If FilePath = "" Then

                    nwb.SaveAs setting_Sh.Range("H7").Value & "/Extract- " & start_loc_num & " to " & end_loc_num & ".xlsx"

                Else
                    Kill (setting_Sh.Range("H7").Value & "/Extract- " & start_loc_num & " to " & end_loc_num & ".xlsx")
                    nwb.SaveAs setting_Sh.Range("H7").Value & "/Extract- " & start_loc_num & " to " & end_loc_num & ".xlsx"

                End If
                    nwb.Close False
                    data_sh.AutoFilterMode = False
        Next

MsgBox "Splitting data Completed!"

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...