从前5行过滤表创建5个报告

时间:2016-03-25 17:42:06

标签: excel vba excel-vba

我是编码宏的新手。我已经从这个网站拉了很多东西让我加快速度,这对我有所帮助。

我正在尝试为过滤表中前五行可见数据的每一行数据创建一个报告。我已经看到列出了几种近似的例子,但我还没弄清楚如何将它们集成到一个正常运行的产品中。帮助让我超越最后的障碍将非常感激。

我的表有一个来自A2:T2的标题行,所以我需要使用xlCellTypeVisible从标题下面的五行拉出,所以只选择了可见的行。表的长度每天变化,但它不会短于150行。

这是我正在尝试创建新工作表的数据代码,并从表的第一行拉出来:

' Create new sheet for report
Sheets.Add After:=Sheets(Sheets.Count) 

' Add Part number, Description & Company to header

' Part Number
Sheets("Variance Data").Range("K3").Copy Destination:=ActiveSheet.Range("A2")
Range("A2").Select
Selection.Font.Bold = True
' Part description
Sheets("Variance Data").Range("L3").Copy Destination:=ActiveSheet.Range("A3")
' Customer
Sheets("Variance Data").Range("G3").Copy Destination:=ActiveSheet.Range("F3")

' Add info from Variance Data tab

' Work Center
Sheets("Variance Data").Range("C3").Copy Destination:=ActiveSheet.Range("A6")
' Work Order
Sheets("Variance Data").Range("H3").Copy Destination:=ActiveSheet.Range("C6")
' Task
Sheets("Variance Data").Range("D3").Copy Destination:=ActiveSheet.Range("D6")
' Seq #
Sheets("Variance Data").Range("I3").Copy Destination:=ActiveSheet.Range("E6")
' Qty
Sheets("Variance Data").Range("M3").Copy Destination:=ActiveSheet.Range("F6")

' Est Hrs
Sheets("Variance Data").Range("O3").Copy Destination:=ActiveSheet.Range("B8")
' Act. Hrs
Sheets("Variance Data").Range("Q3").Copy Destination:=ActiveSheet.Range("B9")
' Var. Hrs
Sheets("Variance Data").Range("S3").Copy Destination:=ActiveSheet.Range("B10")
' Est Cost
Sheets("Variance Data").Range("P3").Copy Destination:=ActiveSheet.Range("E8")
' Act. Cost
Sheets("Variance Data").Range("R3").Copy Destination:=ActiveSheet.Range("E9")
' Var. Cost
Sheets("Variance Data").Range("T3").Copy Destination:=ActiveSheet.Range("E10")

ActiveSheet.Name = Range("A2").Value

如何更改此设置以便我循环创建五张纸,一张用于标题为“差异数据”的主数据表中的每一行数据,并填写新纸张?

感谢您的帮助!

3 个答案:

答案 0 :(得分:0)

查看Cells()。您可以使用Cells(i,j).value来读取和写入i和j为数字的值,并表示行号和列号。然后,您可以将代码括在for循环中。

答案 1 :(得分:0)

如果您需要任何调整,请通知我。请记住,如果要运行宏两次,则需要删除新创建的工作表,因为尝试创建具有相同名称的工作表将导致错误。

如果为新创建的ActiveX命令按钮(获取默认名称CommandButton1)分配了以下代码,则无论您将哪个工作表放在按钮中,都可以使用以下代码。

Option Explicit
Option Base 1

Private Sub CommandButton1_Click()

Dim v_data As Variant
Dim mainsheet As String
Dim thelastrow As Long, visibleRowsCount As Long, arrayRow As Long
Dim ws As Worksheet

'disable screen updating on code execution for faster performance and no screen flickering
Application.ScreenUpdating = False
'name of your data sheet
mainsheet = "Variance Data"

'create an array from sheet data, starting range is defined in code, last row is the last row containing data in your sheet
'only visible rows are taken
With ThisWorkbook.Worksheets(mainsheet)
    thelastrow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    v_data = .Range("a3:t" & thelastrow)

'works for 5 top visible rows - create sheets and populate them with data from array
Do Until visibleRowsCount = 5 Or arrayRow = UBound(v_data)
    arrayRow = arrayRow + 1
    If Not Rows(arrayRow + 2).Hidden Then
        visibleRowsCount = visibleRowsCount + 1
        Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        ws.Name = "Report" & visibleRowsCount
        With ThisWorkbook.Sheets("Report" & visibleRowsCount)
            'Cell value of your new report worksheet = value from data array
            .Range("a5").Value = v_data(arrayRow, 5) 'take data from 5th column of the current row
            .Range("b3").Value = v_data(arrayRow, 1) 'take data from 1st column of the current row
            .Range("d3").Value = v_data(arrayRow, 1) 'take the same data from 1st column of the current row and put in a different cell
        End With
    End If
Loop

End With

Application.ScreenUpdating = True

End Sub

答案 2 :(得分:0)

以下是我感谢Ryszard的当前代码:

    ' If you need any adjustments let me know. Remember that if you want to run the macro twice, you need to remove newly created sheets, because trying to create sheets with the same name will cause an error.

 Option Explicit
 Option Base 1

Sub TestVarRpt() ' Changed to Macro versus ActiveX button, personal preference

Dim v_data As Variant
Dim mainsheet As String
Dim thelastrow As Long, visibleRowsCount As Long, arrayRow As Long

Dim ws As Worksheet

'disable screen updating on code execution for faster performance and no screen flickering
Application.ScreenUpdating = False
'name of your data sheet
mainsheet = "Sheet1" ' **** CHANGE TO "Variance Report" on successful run ****


'create an array from sheet data, starting range is defined in code, last row is the last row containing data in your sheet
'only visible rows are taken
With ThisWorkbook.Worksheets(mainsheet)
thelastrow = .Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
v_data = .Range("a3:t" & thelastrow)

'works for 5 top visible rows - create sheets and populate them with data from array
Do Until visibleRowsCount = 5 Or arrayRow = UBound(v_data)
    arrayRow = arrayRow + 1
    If Not Rows(arrayRow + 2).Hidden Then
        visibleRowsCount = visibleRowsCount + 1
        Set ws = Worksheets.Add(After:=Worksheets(Worksheets.Count))
        ws.Name = "Report" & visibleRowsCount
        With ThisWorkbook.Sheets("Report" & visibleRowsCount)


  ' Part Information
        '   Part Number
         '   Sheets("Variance Data").Range("K" & cnt + 2).Copy Destination:=ActiveSheet.Range("A2")
             .Range("a2").Value = v_data(arrayRow, 11) 'take data from 11th column of the current row

        '   Part description
            'Sheets("Variance Data").Range("L" & cnt + 2).Copy Destination:=ActiveSheet.Range("A3")
             .Range("a3").Value = v_data(arrayRow, 12) 'take data from 12th column of the current row

        '   Customer
            'Sheets("Variance Data").Range("G" & cnt + 2).Copy Destination:=ActiveSheet.Range("F3")
             .Range("f3").Value = v_data(arrayRow, 7) 'take data from 7th column of the current row

        '   Work Center
            'Sheets("Variance Data").Range("C" & cnt + 2).Copy Destination:=ActiveSheet.Range("A6")
             .Range("a6").Value = v_data(arrayRow, 3) 'take data from 3rd column of the current row

        '   Work Order
            'Sheets("Variance Data").Range("H" & cnt + 2).Copy Destination:=ActiveSheet.Range("C6")
             .Range("c6").Value = v_data(arrayRow, 8) 'take data from 8th column of the current row

        '   Task
            'Sheets("Variance Data").Range("D" & cnt + 2).Copy Destination:=ActiveSheet.Range("D6")
             .Range("d6").Value = v_data(arrayRow, 4) 'take data from 5th column of the current row

        '   Seq #
            'Sheets("Variance Data").Range("I" & cnt + 2).Copy Destination:=ActiveSheet.Range("E6")
             .Range("e6").Value = v_data(arrayRow, 9) 'take data from 9th column of the current row

        '   Qty
            'Sheets("Variance Data").Range("M" & cnt + 2).Copy Destination:=ActiveSheet.Range("F6")
             .Range("f6").Value = v_data(arrayRow, 13) 'take data from 13th column of the current row

   ' Hours
        '   Est Hrs
            'Sheets("Variance Data").Range("O" & cnt + 2).Copy Destination:=ActiveSheet.Range("B8")
             .Range("b8").Value = v_data(arrayRow, 15) 'take data from 15th column of the current row

        '   Act. Hrs
            'Sheets("Variance Data").Range("Q" & cnt + 2).Copy Destination:=ActiveSheet.Range("B9")
             .Range("b9").Value = v_data(arrayRow, 17) 'take data from 17th column of the current row

        '   Var. Hrs
            'Sheets("Variance Data").Range("S" & cnt + 2).Copy Destination:=ActiveSheet.Range("B10")
             .Range("b10").Value = v_data(arrayRow, 19) 'take data from 19th column of the current row

   ' Cost
        '   Est Cost
            'Sheets("Variance Data").Range("P" & cnt + 2).Copy Destination:=ActiveSheet.Range("E8")
             .Range("e8").Value = v_data(arrayRow, 16) 'take data from 16th column of the current row

        '   Act. Cost
            'Sheets("Variance Data").Range("R" & cnt + 2).Copy Destination:=ActiveSheet.Range("E9")
             .Range("e9").Value = v_data(arrayRow, 18) 'take data from 18th column of the current row

        '   Var. Cost
            'Sheets("Variance Data").Range("T" & cnt + 2).Copy Destination:=ActiveSheet.Range("E10")
             .Range("e10").Value = v_data(arrayRow, 20) 'take data from 5th column of the current row

            ws.Name = v_data(arrayRow, 11)


        End With
    End If
Loop

End With

Application.ScreenUpdating = True

End Sub

结果是它为前五行创建报告,无论它们是否隐藏。我没有遵循这段代码的逻辑,所以可能是问题。

    Do Until visibleRowsCount = 5 Or arrayRow = UBound(v_data)
    arrayRow = arrayRow + 1 ' Increment array row by one
    If Not Rows(arrayRow + 2).Hidden Then ' If the two rows after current row isn't hidden then
        visibleRowsCount = visibleRowsCount + 1 ' add one to the visible count