得力考勤機導出的資料按部門分類（Excel宏）

Sub text()

Dim i, j, num, row As Integer

Dim arr() As Integer

For i = 1 To 3000

    If Cells(i, 2) = "工号：" Then
    
        ReDim Preserve arr(num + 1)
        
        If i > 0 Then
        
            arr(num) = i
        
        End If
        
        num = num + 1
        
    End If
    
Next

For j = 0 To (UBound(arr) - 1)

       If j < UBound(arr) - 1 Then
       
        For k = 0 To (arr(j + 1) - arr(j) - 1)
        
           If Cells(arr(j), 19) = "銷售部" Then
           
              row = row + 1
           
              For i = 2 To 31
              
                  Rem Debug.Print arr(j) + k, i + 33
                  
                  Cells(row, i + 33) = Cells(arr(j) + k, i)
                  
                  Rem Cells(arr(j) + k, i + 33) = Cells(arr(j) + k, i)
                  
              Next
           
           End If
        
        Next
        
      End If
   
Next

Debug.Print "DONE"

End Sub