VBA Offset循环实现员工考勤数据批量导出至年度表需求

Hey there! Let's work through this VBA attendance summary challenge together—you're already off to a great start with the initial code, so we'll build on that to handle all 55+ employees efficiently while optimizing performance.

Core Improvements & Approach #

We'll fix the loop issue and clean up the code by focusing on these key points:

• Ditch slow, error-prone Select/Activate methods (a common VBA newbie pitfall!)
• Loop through each employee's 42-row data block dynamically
• Efficiently extract green cells and paste them row-by-row into the "Annual" sheet
• Add safeguards to avoid processing empty data blocks

Full Optimized Code #

Here's the revised code with comments to explain each step:

Sub BatchExtractAttendance()
    Dim wsSource As Worksheet, wsTarget As Worksheet
    Dim lastRowTarget As Long, employeeIndex As Integer
    Dim dataBlockStartRow As Long
    Dim greenCellRange As Range, singleCell As Range
    
    ' Set references to our worksheets once (faster than repeated lookups)
    Set wsSource = ThisWorkbook.Worksheets("Monthly Summary")
    Set wsTarget = ThisWorkbook.Worksheets("Annual")
    
    ' Start at the first employee's data block (adjust this if your first row isn't row 1!)
    dataBlockStartRow = 1
    
    ' Loop through up to 60 employees (covers your 55+ with extra buffer)
    For employeeIndex = 1 To 60
        ' Exit loop early if we hit an empty data block (no more employees)
        If wsSource.Cells(dataBlockStartRow, 1).Value = "" Then Exit For
        
        ' Define the current employee's 42-row data range
        Dim currentDataRange As Range
        Set currentDataRange = wsSource.Range( _
            wsSource.Cells(dataBlockStartRow, 1), _
            wsSource.Cells(dataBlockStartRow + 41, wsSource.UsedRange.Columns.Count) _
        )
        
        ' Grab all green cells in this range
        ' Note: If your green is not the default vbGreen, replace with your RGB value (e.g., RGB(0,255,0))
        On Error Resume Next ' Ignore error if no green cells exist in the block
        Set greenCellRange = currentDataRange.SpecialCells(xlCellTypeAllFormatConditions, xlColor)
        On Error GoTo 0 ' Reset error handling
        
        ' Paste the green cell data into the Annual sheet
        If Not greenCellRange Is Nothing Then
            ' Find the next empty row in the target sheet
            lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, 1).End(xlUp).Row + 1
            
            ' Write each green cell's value to a new row
            For Each singleCell In greenCellRange
                wsTarget.Cells(lastRowTarget, 1).Value = singleCell.Value
                ' Uncomment below if you want to copy the cell's formatting too
                ' singleCell.Copy: wsTarget.Cells(lastRowTarget, 1).PasteSpecial xlPasteFormats
                lastRowTarget = lastRowTarget + 1
            Next singleCell
        End If
        
        ' Move down to the next employee's data block (42 rows offset)
        dataBlockStartRow = dataBlockStartRow + 42
    Next employeeIndex
    
    ' Clean up memory by releasing object references
    Set wsSource = Nothing
    Set wsTarget = Nothing
    Set greenCellRange = Nothing
    Set currentDataRange = Nothing
    
    MsgBox "Attendance data extraction complete!", vbInformation
End Sub

Key Details & Customization Tips #

• Avoiding Select/Activate: By directly referencing worksheets and ranges, we make the code faster and more reliable—no more random errors if the user clicks on a different sheet while running the macro.
• Handling Conditional Formatting: If your green cells are set via conditional formatting (not direct fill color), the SpecialCells method might miss them. Use this alternative loop instead to check each cell's color:

  ' Replace the green cell range section with this:
  For Each singleCell In currentDataRange
      ' Use your actual green RGB value here
      If singleCell.Interior.Color = RGB(0, 255, 0) Then
          lastRowTarget = wsTarget.Cells(wsTarget.Rows.Count, 1).End(xlUp).Row + 1
          wsTarget.Cells(lastRowTarget, 1).Value = singleCell.Value
      End If
  Next singleCell
  

• Adjusting Start Row: If your first employee's data doesn't start at row 1, change the dataBlockStartRow initial value (e.g., dataBlockStartRow = 2).
• Dynamic Loop Limit: Instead of hardcoding 60 employees, you could calculate the total number of blocks by dividing the total used rows by 42—let me know if you want help with that!

内容的提问来源于stack exchange，提问作者Dean Cohen