Создание 5 отчетов из пяти верхних строк отфильтрованной таблицы

Question

Я новичок в кодировании макросов. Я много тянул с этого сайта, чтобы ускорить скорость, и это помогло тонну.

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

В моей таблице есть строка заголовка из 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 

Как изменить это, так что я петля это, чтобы создать пять листов, один для каждой строки данных из основного листа данных под названием «Данные дисперсии» и заполнения нового листа?

Благодарим за помощь!

Answer 1

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

Ниже код работает, если не назначены для свежа созданной командной кнопки 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 

Answer 2

Посмотрите на ячейки(). Вы можете использовать Cells (i, j) .value для чтения и записи значений, где i и j являются числовыми и представляют номер строки и номер столбца. Затем вы можете заключить свой код в цикл for.

Answer 3

Вот текущий код у меня есть спасибо to 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