时间戳

首页 > 解决方案 > 根据 9 月 1 日至 9 月 30 日的条件，将数据从主数据复制到多个工作表

excel - 根据 9 月 1 日至 9 月 30 日的条件，将数据从主数据复制到多个工作表

问题描述

我是 VBA 的新手，通过在谷歌中搜索创建脚本并最终在这里寻求帮助，我进行了很多尝试。需要帮助以根据 9 月 1 日至 9 月 30 日的 excel 条件将数据从主数据复制到多个工作表。根据主数据中的 Rownum 列名称复制值。我有一个包含数据的主工作表和需要为每个月生成报告。根据条件 Rownum = 1 for Sep 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

我需要根据条件创建一个多张工作表，直到从主工作表完成 9 月 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

输出

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

标签： excelvba

解决方案

这应该让你朝着正确的方向前进。没有错误检查，我假设如果你运行它两次你会得到一个错误，因为工作表已经存在。

总之是一个好的开始。

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

推荐阅读