自定义函数--提取单元格内多个被分开的数字

YZC51

Sub 双字节转单()
Dim i As Byte
Application.ScreenUpdating = False
For i = 0 To 9
ActiveSheet.Cells.Replace StrConv(i, vbWide), i
Next
ActiveSheet.Cells.Replace "．", "."
Application.ScreenUpdating = True
End Sub
http://club.excelhome.net/thread-250303-1-1.html

YZC51

Function zyr(Optional dat = "", Optional w = 5) '本月总工作日数
If Len(dat) Then st = dat Else st = Date
by_1 = DateSerial(Year(st), Month(st), 1)
byend = DateSerial(Year(st), Month(st) + 1, 0)
For i = by_1 To byend
    If Weekday(i, 2) < w + 1 Then x = x + 1
Next
zyr = x
End Function

Function dyr(Optional dat = "", Optional w = 5) '本月到当前日期工作日数
If Len(dat) Then st = dat Else st = Date
by_1 = DateSerial(Year(st), Month(st), 1)
byend = st
For i = by_1 To byend
    If Weekday(i, 2) < w + 1 Then x = x + 1
Next
dyr = x
End Function

Function sd2ed(sd, ed, Optional w = 5) '2个日期之间工作日数
For i = sd To ed
    If Weekday(i, 2) < w + 1 Then x = x + 1
Next
sd2ed = x
End Function

YZC51

Function NETWORKDAYS_1(sd, ed, Optional arr = 0, Optional w = 5) '2个日期之间工作日数-节假日
On Error Resume Next
For i = sd To ed
    If Weekday(i, 2) < w + 1 Then x = x + 1
Next
If arr.Count = 0 Then NETWORKDAYS_1 = x: Exit Function
For i = 1 To arr.Count
   If arr(i, 1) <= ed And arr(i, 1) >= sd Then x = x - 1
Next
NETWORKDAYS_1 = x
End Function

YZC51

原创
Function NETWORKDAYS_2(sd, ed, Optional arr = 0, Optional brr = 0, Optional w = 5) '2个日期之间工作日数-节假日+调休日
    'sd     参数    开始日期
    'ed     参数    结束日期
    'arr    参数    法定假日单元格区域
    'brr    参数    假日调休单元格区域
    'w      参数    每周工作日数
    On Error Resume Next
    For i = sd To ed
        If Weekday(i, 2) < w + 1 Then x = x + 1
    Next
   
    If brr.Count = 0 Then GoTo aa
    For i = 1 To brr.Count
       If brr(i, 1) <= ed And brr(i, 1) >= sd Then x = x + 1
    Next
   
aa:
    If arr.Count = 0 Then NETWORKDAYS_2 = x: Exit Function
    For i = 1 To arr.Count
       If arr(i, 1) <= ed And arr(i, 1) >= sd Then x = x - 1
    Next
    NETWORKDAYS_2 = x
End Function

WYS67

YZC51 发表于 2019-6-28 06:53
原创
Function NETWORKDAYS_2(sd, ed, Optional arr = 0, Optional brr = 0, Optional w = 5) '2个日期之 ...

大神啊！赠人玫瑰手留余香！正在拜读老师大作中！

WYS67

YZC51 发表于 2019-6-18 08:51
Sub 双字节转单()
Dim i As Byte
Application.ScreenUpdating = False

老师：恳请您看看  http://club.excelhome.net/thread-1485412-1-1.html帖子里，怎样添加--当数据源为空格时，对应的结果也必须显示为空白的代码？

YZC51

NETWORKDAYS.INTL函数的增强版
Function NETWORKDAYS2INTL(start_date, end_date, Optional weekend = 1, Optional holidays = 0, Optional BreakOff = 0) '2个日期之间工作日数-节假日+调休日
    'NETWORKDAYS.INTL(start_date, end_date, [weekend], [holidays],[BreakOff])
    'start_date     参数    开始日期
    'end_date       参数    结束日期
    'weekend        参数    每周工作日数
    'holidays       参数    法定假日单元格区域
    'BreakOff       参数    假日调休单元格区域
    '周末数     周末日
    '0          整周都是工作日
    '1 或省略    星期六、星期日
    '2          星期日、星期一
    '3          星期一、星期二
    '4          星期二、星期三
    '5          星期三、星期四
    '6          星期四、星期五
    '7          星期五、星期六

    '11         仅星期日
    '12         仅星期一
    '13         仅星期二
    '14         仅星期三
    '15         仅星期四
    '16         仅星期五
    '17         仅星期六

    On Error Resume Next
    If weekend = 0 Then NETWORKDAYS2INTL = end_date - start_date: Exit Function
    Z = weekend Mod 10: x = 0
    If Z > 7 Then NETWORKDAYS2INTL = "#N/A": Exit Function
    If end_date > start_date Then yzc = 1 Else yzc = -1 '***
    w = Z: w2 = (Z + 5 Mod 7) + 1: x = 0
    If Len(weekend) = 1 Then
        If end_date = start_date And (Weekday(start_date, 1) <> w And Weekday(start_date, 1) <> w2) Then x = 0: GoTo bb '***2
        For i = start_date + 1 To end_date Step yzc
            If Weekday(i, 1) <> w And Weekday(i, 1) <> w2 Then x = x + yzc
        Next
    Else
        For i = start_date To end_date Step yzc
            If Weekday(i, 2) <> w Then x = x + yzc
        Next
    End If
    If BreakOff.Count = 0 Then GoTo aa
    For i = 1 To BreakOff.Count
        If BreakOff(i, 1) >= start_date And BreakOff(i, 1) <= end_date Then x = x + yzc
    Next
aa:
    If holidays.Count = 0 Then NETWORKDAYS2INTL = x: Exit Function
    For i = 1 To holidays.Count
        If holidays(i, 1) > start_date And holidays(i, 1) <= end_date Then
            If Len(weekend) = 1 Then
                If Weekday(holidays(i, 1), 1) <> w Then x = x - yzc
                If Weekday(holidays(i, 1), 1) = w2 Then x = x + yzc            Else
                If Weekday(holidays(i, 1), 1) <> w Then x = x - yzc
            End If
        End If
    Next
bb:
    NETWORKDAYS2INTL = x
End Function

YZC51

Function WORKDAY2INTL(start_date, days, Optional weekend = 1, Optional holidays = 0, Optional BreakOff = 0)
   'Function WORKDAY2INTL(start_date, days, [weekend], [holidays], [BreakOff])
    'start_date     参数    开始日期
    'days           参数    工作日天数
    'weekend        参数    每周工作日数
    'holidays       参数    法定假日单元格区域
    'BreakOff       参数    假日调休单元格区域
    '周末数     周末日
    '0          整周都是工作日
    '1或省略    星期六、星期日
    '2          星期日、星期一
    '3          星期一、星期二
    '4          星期二、星期三
    '5          星期三、星期四
    '6          星期四、星期五
    '7          星期五、星期六
   
    '11         仅星期日
    '12         仅星期一
    '13         仅星期二
    '14         仅星期三
    '15         仅星期四
    '16         仅星期五
    '17         仅星期六

    On Error Resume Next
    Z = weekend Mod 10: x = 0: xx = 0
    If Z > 7 Then WORKDAY2INTL = "#N/A": Exit Function
    If weekend = 0 Then WORKDAY2INTL = start_date + days: Exit Function
    If end_date + days > start_date Then yzc = 1 Else yzc = -1 '***

    For i = days To days * 7 Step 1
        x = NETWORKDAYS2INTL(start_date, start_date + i, weekend, holidays, BreakOff)
        If x = days Then xx = i: Exit For
    Next
    WORKDAY2INTL = start_date + xx
End Function

YZC51

上面两个自定义函数的示例文件。
NETWORKDAYS.INTL函数的语法结构-V2.rar (71.04 KB, 下载次数: 183)

2019-7-5 18:39 上传

点击文件名下载附件
18:40更新

YZC51

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'选中跳转到最后格
    col = Target.Column
    r = Cells(Rows.Count, col).End(xlUp).Row + 1
    If r < 5 Then r = 5
    Cells(r, col).Select
End Sub