统计Excel工时的VBA脚本

很久很久以前,用于统计公司工时的一个VBA脚本,只使用了一小段时间。
代码写的有些傻傻的,哈哈哈。

Sub Summary()

    '统计行数
    Dim TotalLine As Integer
    TotalLine = 1
    
    Dim i, j As Integer
    i = 1
    j = 1
    
    Dim name As String
    
    '清空上次统计信息
    Sheet32.Range("A2:F301").ClearContents
    
    '计算人名
    name = Sheet1.Cells(2, 2)
    name = Right(name, Len(name) - 3)

    '遍历所有sheets
    For i = 1 To 31
    
        '每个sheets中有效行数
        For j = 4 To 12
        
            '判断一行是否为空
            If (Worksheets(i).Cells(j, 1) = "" And Worksheets(i).Cells(j, 2) = "" And Worksheets(i).Cells(j, 3) = "" And Worksheets(i).Cells(j, 4) = "" And Worksheets(i).Cells(j, 5) = "") Then
                '空行,不做处理
            Else
                '非空行,进行统计
                TotalLine = TotalLine + 1
                Sheet32.Cells(TotalLine, 1) = Worksheets(i).Cells(j, 4)
                Sheet32.Cells(TotalLine, 2) = Worksheets(i).Cells(j, 5)
                Sheet32.Cells(TotalLine, 3) = name
                
                If (Worksheets(i).Cells(j, 2) = "/") Then
                    Sheet32.Cells(TotalLine, 4) = "0"
                Else
                    Sheet32.Cells(TotalLine, 4) = Worksheets(i).Cells(j, 2)
                End If
                
                If (Worksheets(i).Cells(j, 3) = "/") Then
                    Sheet32.Cells(TotalLine, 5) = "0"
                Else
                    Sheet32.Cells(TotalLine, 5) = Worksheets(i).Cells(j, 3)
                End If

                Sheet32.Cells(TotalLine, 6) = Sheet32.Cells(TotalLine, 4) + Sheet32.Cells(TotalLine, 5)
            End If
        Next j
    Next i
    
    '清空上次统计信息
    Sheet33.Range("A2:F301").ClearContents
    
    '任务行数
    Dim TaskLine As Integer
    TaskLine = 1
    
    '本条记录是否添加
    Dim bFind As Boolean
    
    '效率低下的循环
    For i = 2 To TotalLine
        bFind = False
        For j = 2 To TaskLine
            If (Sheet32.Cells(i, 1) = Sheet33.Cells(j, 1) And Sheet32.Cells(i, 2) = Sheet33.Cells(j, 2)) Then
                Sheet33.Cells(j, 4) = Sheet33.Cells(j, 4) + Sheet32.Cells(i, 4)
                Sheet33.Cells(j, 5) = Sheet33.Cells(j, 5) + Sheet32.Cells(i, 5)
                Sheet33.Cells(j, 6) = Sheet33.Cells(j, 6) + Sheet32.Cells(i, 6)
                bFind = True
                Exit For
            End If
        Next j
        
        If (Not bFind) Then
                TaskLine = TaskLine + 1
                Sheet33.Cells(TaskLine, 1) = Sheet32.Cells(i, 1)
                Sheet33.Cells(TaskLine, 2) = Sheet32.Cells(i, 2)
                Sheet33.Cells(TaskLine, 3) = Sheet32.Cells(i, 3)
                Sheet33.Cells(TaskLine, 4) = Sheet32.Cells(i, 4)
                Sheet33.Cells(TaskLine, 5) = Sheet32.Cells(i, 5)
                Sheet33.Cells(TaskLine, 6) = Sheet32.Cells(i, 6)
        End If
        
    Next i
    
    MsgBox ("任务完成咯 :)")
    
End Sub

Comments are closed.