Скопируйте данные из основных данных на несколько листов на основе условия с 1 по 30 сентября. - PullRequest
Новая
       12

Скопируйте данные из основных данных на несколько листов на основе условия с 1 по 30 сентября.

0 голосов
/ 19 октября 2018

Я новичок в VBA, и я много пробовал, выполняя поиск в Google, чтобы создать сценарий и, наконец, попал сюда за помощью.нужна помощь в этом, чтобы скопировать данные из основных данных в несколько листов на основе условия в Excel за период с 1 по 30 сентября. копировать значения, основанные на имени столбца Rownum, из основных данных. У меня есть мастер-лист с данными иНужно сгенерировать отчет за каждый месяц.Создание нескольких листов на основе условия Rownum = 1 для 1 сентября и т. Д. 

Ex:-

Rownum = 1  for Sep 1
Rownum = 2  for Sep 2
Rownum = 3  for Sep 3
Rownum = 4  for Sep 4
Rownum = 5  for Sep 5
.
.
Rownum = 29  for Sep 29
Rownum = 30  for Sep 30

Мне нужно создать несколько листов на основе условия, пока 30 сентября не будет сделано из основного листа.

Пример данных 

MasterSheet     
Date    Value   RowNums
8/31/2018 9:45  0   1
8/31/2018 10:35 0   1
9/1/2018 6:15   3   1
9/1/2018 9:45   0   2
9/1/2018 10:35  0   2
9/2/2018 4:45   8   2
9/2/2018 5:35   32  2
9/2/2018 6:15   3   2
9/2/2018 9:15   0   3
9/2/2018 11:15  0   3
9/3/2018 5:35   65  3
9/3/2018 6:15   36  3
9/3/2018 9:15   8   4
9/4/2018 6:25   0   4

OutPut 

SheetName   1-Sep   
Date    Value   RowNums
8/31/2018 9:45  0   1
8/31/2018 10:35 0   1
9/1/2018 6:15   3   1
SheetName   2-Sep   
Date    Value   RowNums
9/1/2018 9:45   0   2
9/1/2018 10:35  0   2
9/2/2018 4:45   8   2
9/2/2018 5:35   32  2
9/2/2018 6:15   3   2
SheetName   3-Sep   
Date    Value   RowNums
9/2/2018 9:15   0   3
9/2/2018 11:15  0   3
9/3/2018 5:35   65  3
9/3/2018 6:15   36  3
SheetName   4-Sep   
Date    Value   RowNums
9/3/2018 9:15   8   4
9/4/2018 6:25   0   4

Заранее спасибо. 

Option Explicit

Sub AddSheets()
    Dim siteCount As Integer
    Dim i As Integer
    Dim site_i As Worksheet

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("MasterSheet")

    Dim r As Long, endRow as Long, pasteRowIndex As Long
    ' endRow = Cells(Rows.Count, "C").End(xlUp).Row

    siteCount = 3

    For i = 1 To siteCount
        Set site_i = Sheets.Add(after:=Sheets(Worksheets.Count))
        site_i.Name = "Sep " & CStr(i)
    Next i
    Sheets.FillAcrossSheets ws.Range("1:1")

    Sheets("MasterSheet").Select
    endRow = Cells(Rows.Count, "C").End(xlUp).Row
    pasteRowIndex = 2
    For r = 2 To endRow

        If Cells(r, Columns("C").Column).Value = 1 Then

            Rows(r).Select
            Selection.Copy

            Sheets("Sep 1").Select
            Rows(pasteRowIndex).Select
            ActiveSheet.Paste

            pasteRowIndex = pasteRowIndex + 1
            Sheets("MasterSheet").Select 
        End If
    Next r

End Sub

1 Ответ

0 голосов
/ 19 октября 2018

Это должно привести вас в правильном направлении.нет проверки ошибок, я предполагаю, что если вы запустите ее дважды, вы получите ошибку, потому что рабочая таблица уже существует.

В любом случае, хорошее начало. 

Sub UsingCollection()
    Dim cUnique As Collection
    Dim Rng As Range
    Dim Cell As Range
    Dim sh As Worksheet
    Dim vNum As Variant, s As String
    Dim LstRw As Long, cRng As Range, C As Range, ws As Worksheet

    Set sh = ThisWorkbook.Sheets("Sheet1")

    With sh
        Set Rng = .Range("A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row)
        Set cUnique = New Collection
        LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
        Set Rng = .Range("A2:A" & LstRw)
        On Error Resume Next
        For Each Cell In Rng.Cells
            cUnique.Add Cell.Value, CStr(Cell.Value)
        Next Cell
        On Error GoTo 0

        For Each vNum In cUnique

            s = Format(vNum, "MM-DD-YY")
            Set ws = Sheets.Add
            ws.Name = s

            For Each C In Rng.Cells
                If C = vNum Then
                    .Range(.Cells(C.Row, "A"), .Cells(C.Row, "D")).Copy ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1)
                End If
            Next C
        Next vNum
    End With

End Sub
...