Excel vba将已使用行的平均数量复制到另一个工作表

时间:2018-05-14 21:36:03

标签: excel vba excel-vba

我有一个每个月都会改变的数据集。需要对数据集进行划分并分配给工作人员进行审查。行数将逐月变化,但不是列。我目前从对工作人员有用的列中复制数据并将它们放在另一个工作表中。我想进一步将数据与员工的平均数量分开,这不会改变。我附上了几张照片,以便更好地说明我想要完成的任务。我的vba将会选择"行按照我想要的方式排序,但我无法弄清楚如何将数据移动到sheet3,即使使用我用来将数据从sheet1移动到sheet2的代码的修改。

谢谢!

Option Explicit
Sub runAll()
    Call fltrColumns
End Sub

Sub fltrColumns()

    Dim lastRow As Long
    Dim avgRow As Long

    Worksheets("Sheet2").Cells.ClearContents    'Clears data on Sheet2

    lastRow = Worksheets("Sheet1").Range("E" & Rows.Count).End(xlUp).Offset(-1).Row    'Counts rows minus the header

    avgRow = lastRow / 9    'Average based on a constant of nine personnel

    'Copy specific data over to Sheet2
    Worksheets("Sheet2").Range("A1:A" & lastRow).Value = Worksheets("Sheet1").Range("E1:E" & lastRow).Value
    Worksheets("Sheet2").Range("B1:B" & lastRow).Value = Worksheets("Sheet1").Range("F1:F" & lastRow).Value
    Worksheets("Sheet2").Range("C1:C" & lastRow).Value = Worksheets("Sheet1").Range("B1:B" & lastRow).Value
    Worksheets("Sheet2").Range("D1:D" & lastRow).Value = Worksheets("Sheet1").Range("A1:A" & lastRow).Value
    Worksheets("Sheet2").Range("E1:E" & lastRow).Value = Worksheets("Sheet1").Range("G1:G" & lastRow).Value
    Worksheets("Sheet2").Range("F1:F" & lastRow).Value = Worksheets("Sheet1").Range("H1:H" & lastRow).Value
    Worksheets("Sheet2").Range("G1:G" & lastRow).Value = Worksheets("Sheet1").Range("I1:I" & lastRow).Value
    Worksheets("Sheet2").Range("H1:H" & lastRow).Value = Worksheets("Sheet1").Range("L1:L" & lastRow).Value
    Worksheets("Sheet2").Range("I1:I" & lastRow).Value = Worksheets("Sheet1").Range("M1:M" & lastRow).Value
    Worksheets("Sheet2").Range("J1:J" & lastRow).Value = Worksheets("Sheet1").Range("J1:J" & lastRow).Value
    Worksheets("Sheet2").Range("K1:K" & lastRow).Value = Worksheets("Sheet1").Range("C1:C" & lastRow).Value
    Worksheets("Sheet2").Range("L1:L" & lastRow).Value = Worksheets("Sheet1").Range("D1:D" & lastRow).Value

    'Used to see if the values are calculating correctly
    'MsgBox lastRow
    'MsgBox avgRow

    staffAverage (avgRow)

End Sub

Sub staffAverage(ByVal avgRow As Long)

    Dim grpOne As Long
    Dim grpTwo As Long
    Dim grpThree As Long
    Dim grpFour As Long
    Dim grpFive As Long
    Dim grpSix As Long
    Dim grpSeven As Long
    Dim grpEight As Long
    Dim grpNine As Long

    grpOne = avgRow
    grpTwo = avgRow * 2
    grpThree = avgRow * 3
    grpFour = avgRow * 4
    grpFive = avgRow * 5
    grpSix = avgRow * 6
    grpSeven = avgRow * 7
    grpEight = avgRow * 8
    grpNine = avgRow * 9

    Worksheets("Sheet2").Range("A1", Cells(grpOne, 12)).Offset(1).Select
    'Worksheets("Sheet2").Range(Cells(grpOne, 1).Offset(1), Cells(grpTwo, 12)).Offset(1).Select
    'Worksheets("Sheet2").Range(Cells(grpTwo, 1).Offset(1), Cells(grpThree, 12)).Offset(1).Select
    'Worksheets("Sheet2").Range(Cells(grpThree, 1).Offset(1), Cells(grpFour, 12)).Offset(1).Select
    'Worksheets("Sheet2").Range(Cells(grpFour, 1).Offset(1), Cells(grpFive, 12)).Offset(1).Select
    'Worksheets("Sheet2").Range(Cells(grpFive, 1).Offset(1), Cells(grpSix, 12)).Offset(1).Select
    'Worksheets("Sheet2").Range(Cells(grpSix, 1).Offset(1), Cells(grpSeven, 12)).Offset(1).Select
    'Worksheets("Sheet2").Range(Cells(grpSeven, 1).Offset(1), Cells(grpEight, 12)).Offset(1).Select
    'Worksheets("Sheet2").Range(Cells(grpEight, 1).Offset(1), Cells(grpNine, 12)).Offset(1).Select
End Sub

enter image description here

enter image description here

0 个答案:

没有答案