zoukankan      html  css  js  c++  java
  • 用VBA计算两个日期之间的工作日(去掉周末两天)

    最近公司HR和Finance想算员工的工作天数,想让我帮忙写些VBA,自己从网上找了下代码,自己再改改,以下来自网络。

    计算两个日期之间的工作日,用VBA,因量大,最好用数组做

    Sub kk()
    Dim arr, i&, j&, m&
    arr = Sheet2.Range("b3:f4")
    For i = 1 To UBound(arr)
        m = 0
        For j = arr(i, 1) To arr(i, 3)
           If Weekday(j) <> 1 And Weekday(j) <> 7 Then m = m + 1
        Next
        arr(i, 5) = m
    Next
    Sheet2.Range("b3").Resize(UBound(arr), 5) = arr
    End Sub

    根据他提供的方法,其实就是判断某个日期是星期一到星期五就日期计数加1,一直到结束,自己改良了下:

    Sub m1()
    For i = 2 To 5000
        days = 0
        
        If Range("b" & i) <> "" And Range("c" & i) <> "" Then
            
            Dim d1, d2 As Date
            d1 = Cells(i, "b")
            d2 = Cells(i, "c")
            
            Do While d1 <= d2
            If Weekday(d1, vbMonday) < 6 Then
                days = days + 1
            End If
                d1 = DateAdd("d", 1, d1)
            Loop
            
            Range("d" & i) = days
            
        End If
    Next
    End Sub

    上面的这个方法只算是可以运行,如果计算的天数多并且员工数多,则效果就差了,所以又有了下面的改良。

    计算两个日期的整周数,然后乘5,在加上前后不够整周的零头。

    Sub m2()
    For i = 2 To 5000
        If Range("b" & i) <> "" And Range("c" & i) <> "" Then
            Dim d1, d2 As Date
            d1 = Cells(i, "b")
            d2 = Cells(i, "c")
            days1 = 0
            days2 = 0
            weekcount = 0
            
            Do While Weekday(d1, vbMonday) < 7 And d1 <= d2
            If Weekday(d1, vbMonday) < 6 Then
                days1 = days1 + 1
            End If
                d1 = DateAdd("d", 1, d1)
            Loop
            
            weekcount = DateDiff("w", d1, d2, vbMonday)
            days2 = Weekday(d2, vbMonday)
            days2 = IIf(days2 = 6, 5, IIf(days2 = 7, 0, days2))
            Range("d" & i) = IIf(d1 >= d2, days1, days1 + 5 * weekcount + days2)
            
        End If
    Next
    
    End Sub

    以上代码可以通过测试验证效率,如下代码

    Sub Button2_Click()
        d1 = Timer
        m1
        'm2
        d2 = Timer
        MsgBox d2 - d1
    End Sub

    参考出处:http://www.excelpx.com/thread-299850-1-1.html

  • 相关阅读:
    如何在delphi里面控制Edit只能输入数字
    ShellExecute函数
    GetSystemMenu 获取系统菜单
    StringReplace 函数
    delphi 字符串查找
    Pos 函数
    Copy 函数
    css笔记
    HTML5笔记
    node.js nodejs supvisor模块
  • 原文地址:https://www.cnblogs.com/mq0036/p/5059730.html
Copyright © 2011-2022 走看看