根据人员休息对应的日期，提前相应的休息日期格式

飞扬520

各位大侠，您们好，麻烦帮忙写个公式。
根据行日期，列的工号所对应的休息情况，连续日期用“-”符号连接，隔开休息日期用“/”分开，如F0001，安排休息是17,18,29,30休息的话，用17-18/29-30显示。具体如附件,根据A列和行2数据对应的休息情况，要求结果如AG列形式。
谢谢！

蓝桥玄霜

请见代码。

飞扬520

蓝桥玄霜 发表于 2018-7-25 10:34
请见代码。

感谢，代码不能复制，是图片来的，我是菜鸟，麻烦大哥发一下能复制的代码，感谢

飞扬520

蓝桥玄霜 发表于 2018-7-25 10:34
请见代码。

版主大哥，能不能把做好的附件发给我，我不怎么懂，感谢！

小新De和尚头

GetDate.rar (181.46 KB, 下载次数: 4)

2018-7-25 11:11 上传

点击文件名下载附件

用法：
如图所示

双击文件打开，然后点击启用此加载项
输入函数=GetDate(B3:AF3)
结果如图

飞扬520

小新De和尚头 发表于 2018-7-25 11:18
用法：
如图所示

谢谢，打不文件啊，我用的是2007版，打开是空白的，什么都没有

lsdongjh

1. Sub Test()
   
2.     Dim arrTitle As Variant
   
3.     Dim arr As Variant, lngRow As Long, lngR As Long
   
4.     Dim brr As Variant, arrResult As Variant
   
5.     Dim strTemp As String
   
6.    
   
7.    
   
8.     arr = Sheet1.Range("B2:AF26")
   
9.     arrTitle = Application.WorksheetFunction.Index(arr, 1, 0)
   
10.     arrResult = Sheet1.Range("AG2:AG26")
    
11.    
    
12.     For lngRow = 2 To UBound(arr)
    
13.         brr = Application.WorksheetFunction.Index(arr, lngRow, 0)
    
14.         For lngR = LBound(brr) To UBound(brr)
    
15.             If brr(lngR) <> "" Then brr(lngR) = arrTitle(lngR)
    
16.         Next
    
17.         strTemp = Join(brr, " ")
    
18.         strTemp = Trim(strTemp)
    
19.         strTemp = Replace(strTemp, " ", "-")
    
20.         strTemp = Replace(strTemp, "--", "/")
    
21.         Do Until InStr(strTemp, "//") < 1
    
22.         strTemp = Replace(strTemp, "//", "/")
    
23.         Loop
    
24.         strTemp = Replace(strTemp, "/-", "/")
    
25.         arrResult(lngRow, 1) = strTemp
    
26.     Next
    
27.    
    
28.     Sheet1.Range("AG2:AG26") = arrResult
    
29. End Sub

复制代码

lsdongjh

用字符串的方式处理，逻辑上简单一些，代码在上楼：

飞扬520

lsdongjh 发表于 2018-7-25 11:53
用字符串的方式处理，逻辑上简单一些，代码在上楼：

非常感谢。

YZC51

请测试
Function myjoin(rng, Optional x = "", Optional y = 0)
On Error Resume Next
    arr = rng
    ss = ""
    For i = 1 To UBound(arr, 1)
    For j = 1 To UBound(arr, 2)
         If arr(i, j) <> "" Then
            If arr(i, j - 1) <> "" Then ss = ss & x & j Else ss = ss & "/" & j
        End If
    Next
    Next
    myjoin = Mid(ss, 1 + Len(x))
    If y Then myjoin = Len(ss)
End Function