VBA偏移循环

时间：2018-05-24 11:09:23

标签： excel vba excel-vba

我对VBA很新，正在为员工时钟制作摘要。 我在以下格式的报告中有员工信息[图片1] 但是想在一个月末编制工资单后，设置一个按钮，将这些按钮以[图2]中所示的格式导出到年度表（在另一个工作表中）。

每个员工报告的样子:(我希望所有细胞都是绿色的）

enter image description here

上面列出的报告列表 - 大约55名以上员工的布局相同，此列表继续向下，偏移量为42。

enter image description here

我想如何格式化从每位员工那里获取的数据：

enter image description here

目前我编写的代码（见下文）适用于第一位员工，但我需要复制相同的单元格选择，其中42个单元格的偏移量减少约55次，同时将年度摘要页面向下偏移一个移动到新的一行。 我很欣赏我的代码可能非常混乱，所以如果有任何改进，我可以做到这也有帮助！

Sub AnnualSummaryTest()

Application.ScreenUpdating = False

'------------Set Variables----------
Dim EmployeeName            As Range
Dim Month                   As Range
Dim ClockNumber             As Range
Dim ShiftHours              As Range
Dim PayPeriodStart          As Range
Dim PayPerdiodEnd           As Range
'-----------------------------------
Dim TotalHours              As Range
Dim TotalWorkedHours        As Range
Dim CountHolidays           As Range
Dim TotalSickHours          As Range
Dim TotalSaturdayHours      As Range
Dim TotalBankHolidayHours   As Range
Dim CountSSPDays            As Range
Dim CountFlexiDays          As Range
'-----------------------------------
Dim PasteRange              As Range
'-----------------------------------

'------------Set Ranges-------------
Set EmployeeName = Worksheets("Monthly Summary").Range("J4")
Set Month = Worksheets("Monthly Summary").Range("J5")
Set ClockNumber = Worksheets("Monthly Summary").Range("O4")
Set ShiftHours = Worksheets("Monthly Summary").Range("O5")
Set PayPeriodStart = Worksheets("Monthly Summary").Range("T4")
Set PayPerdiodEnd = Worksheets("Monthly Summary").Range("T5")
'-----------------------------------
Set TotalHours = Worksheets("Monthly Summary").Range("K41")
Set TotalWorkedHours = Worksheets("Monthly Summary").Range("K42")
Set CountHolidays = Worksheets("Monthly Summary").Range("K43")
Set TotalSickHours = Worksheets("Monthly Summary").Range("Q41")
Set TotalSaturdayHours = Worksheets("Monthly Summary").Range("Q42")
Set TotalBankHolidayHours = Worksheets("Monthly Summary").Range("Q43")
Set CountSSPDays = Worksheets("Monthly Summary").Range("T41")
Set CountFlexiDays = Worksheets("Monthly Summary").Range("T42")
'-----------------------------------
Set PasteRange = Worksheets("Annual").Range("A2")
'-----------------------------------

'------------Copy Ranges------------
EmployeeName.Copy
    With PasteRange.Offset(0, 0)
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    SkipBlanks = False
    End With
Month.Copy
    With PasteRange.Offset(0, 1)
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    SkipBlanks = False
    End With
ClockNumber.Copy
    With PasteRange.Offset(0, 2)
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    SkipBlanks = False
    End With
ShiftHours.Copy
    With PasteRange.Offset(0, 3)
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    SkipBlanks = False
    End With
PayPeriodStart.Copy
    With PasteRange.Offset(0, 4)
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    SkipBlanks = False
    End With
PayPerdiodEnd.Copy
    With PasteRange.Offset(0, 5)
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    SkipBlanks = False
    End With
'-----------------------------------
TotalHours.Copy
    With PasteRange.Offset(0, 6)
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    SkipBlanks = False
    End With
TotalWorkedHours.Copy
    With PasteRange.Offset(0, 7)
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    SkipBlanks = False
    End With
CountHolidays.Copy
    With PasteRange.Offset(0, 8)
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    SkipBlanks = False
    End With
TotalSickHours.Copy
    With PasteRange.Offset(0, 9)
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    SkipBlanks = False
    End With
TotalSaturdayHours.Copy
    With PasteRange.Offset(0, 10)
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    SkipBlanks = False
    End With
TotalBankHolidayHours.Copy
    With PasteRange.Offset(0, 11)
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    SkipBlanks = False
    End With
CountSSPDays.Copy
    With PasteRange.Offset(0, 12)
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    SkipBlanks = False
    End With
CountFlexiDays.Copy
    With PasteRange.Offset(0, 13)
    .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    SkipBlanks = False
    End With
'-----------------------------------


Application.CutCopyMode = False
Application.ScreenUpdating = True
MsgBox "Export Complete"

End Sub

谢谢！ ：）

2 个答案:

答案 0 :(得分：0)

只需循环并使用一个计数器:(一般的想法，如果我看不到员工的数据是如何组织的，我无法给你一个更好的解决方案）

emp_offset = 42
for i = 0 to n ' n = 55??
    EmployeeName.offset(i,0).Copy
    With PasteRange.Offset(i, 0)
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
       SkipBlanks = False
    End With
    Month.offset(emp_offset*i,0).Copy
    With PasteRange.Offset(i, 1)
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
      SkipBlanks = False
    End With
next

答案 1 :(得分：0)

我的解决方案，感谢Gerardo Flores。

Sub AnnualSummaryTest()

'disables screen flickering
Application.ScreenUpdating = False
'Amount of cells to offset downwards
CopyOffset = 42

'------------Set Variables----------
Dim EmployeeName            As Range
Dim Month                   As Range
Dim ClockNumber             As Range
Dim ShiftHours              As Range
Dim PayPeriodStart          As Range
Dim PayPerdiodEnd           As Range
'-----------------------------------
Dim TotalHours              As Range
Dim TotalWorkedHours        As Range
Dim CountHolidays           As Range
Dim TotalSickHours          As Range
Dim TotalSaturdayHours      As Range
Dim TotalBankHolidayHours   As Range
Dim CountSSPDays            As Range
Dim CountFlexiDays          As Range
'-----------------------------------
Dim PasteRange              As Range
'-----------------------------------

'------------Set Ranges-------------
Set EmployeeName = Worksheets("Monthly Summary").Range("J4")
Set Month = Worksheets("Monthly Summary").Range("J5")
Set ClockNumber = Worksheets("Monthly Summary").Range("O4")
Set ShiftHours = Worksheets("Monthly Summary").Range("O5")
Set PayPeriodStart = Worksheets("Monthly Summary").Range("T4")
Set PayPerdiodEnd = Worksheets("Monthly Summary").Range("T5")
'-----------------------------------
Set TotalHours = Worksheets("Monthly Summary").Range("K41")
Set TotalWorkedHours = Worksheets("Monthly Summary").Range("K42")
Set CountHolidays = Worksheets("Monthly Summary").Range("K43")
Set TotalSickHours = Worksheets("Monthly Summary").Range("Q41")
Set TotalSaturdayHours = Worksheets("Monthly Summary").Range("Q42")
Set TotalBankHolidayHours = Worksheets("Monthly Summary").Range("Q43")
Set CountSSPDays = Worksheets("Monthly Summary").Range("T41")
Set CountFlexiDays = Worksheets("Monthly Summary").Range("T42")
'-----------------------------------
Set PasteRange = Worksheets("Annual").Range("A2")
'-----------------------------------

'------------Copy Ranges------------
'Loop Start
'n is number of times to run offset
n = 55
For i = 0 To n
'-----------------------------------
    EmployeeName.Offset(CopyOffset * i, 0).Copy
    With PasteRange.Offset(i, 0)
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
       SkipBlanks = False
    End With

    Month.Offset(CopyOffset * i, 0).Copy
    With PasteRange.Offset(i, 1)
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
      SkipBlanks = False
    End With

    ClockNumber.Offset(CopyOffset * i, 0).Copy
    With PasteRange.Offset(i, 2)
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
      SkipBlanks = False
    End With

    ShiftHours.Offset(CopyOffset * i, 0).Copy
    With PasteRange.Offset(i, 3)
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
      SkipBlanks = False
    End With

    PayPeriodStart.Offset(CopyOffset * i, 0).Copy
    With PasteRange.Offset(i, 4)
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
       SkipBlanks = False
    End With

    PayPerdiodEnd.Offset(CopyOffset * i, 0).Copy
    With PasteRange.Offset(i, 5)
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
      SkipBlanks = False
    End With
'-----------------------------------
    TotalHours.Offset(CopyOffset * i, 0).Copy
    With PasteRange.Offset(i, 6)
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
      SkipBlanks = False
    End With

    TotalWorkedHours.Offset(CopyOffset * i, 0).Copy
    With PasteRange.Offset(i, 7)
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
      SkipBlanks = False
    End With

    CountHolidays.Offset(CopyOffset * i, 0).Copy
    With PasteRange.Offset(i, 8)
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
       SkipBlanks = False
    End With

    TotalSickHours.Offset(CopyOffset * i, 0).Copy
    With PasteRange.Offset(i, 9)
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
      SkipBlanks = False
    End With

    TotalSaturdayHours.Offset(CopyOffset * i, 0).Copy
    With PasteRange.Offset(i, 10)
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
      SkipBlanks = False
    End With

    TotalBankHolidayHours.Offset(CopyOffset * i, 0).Copy
    With PasteRange.Offset(i, 11)
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
      SkipBlanks = False
    End With

    CountSSPDays.Offset(CopyOffset * i, 0).Copy
    With PasteRange.Offset(i, 12)
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
       SkipBlanks = False
    End With

    CountFlexiDays.Offset(CopyOffset * i, 0).Copy
    With PasteRange.Offset(i, 13)
      .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
      SkipBlanks = False
    End With
'-----------------------------------
    Next


'-----------------------------------
'Removes 'walking ants' on copied selection
Application.CutCopyMode = False
'Resets Screenupdating to true
Application.ScreenUpdating = True
'Pop up box on completion
MsgBox "      Export Complete      "

End Sub
相关问题
最新问题