Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
查看: 2553|回复: 8

[已解决]合并单元格内容(只取起止日期)

[复制链接]
发表于 2015-7-6 15:44 | 显示全部楼层 |阅读模式
合并单元格内容,之前论坛里有关于这方面的示例

小弟能力有限,只修改为提取格式“月/日”

Function demo(rng As Range)
    Dim j As Integer, n As Integer
    If rng.Rows.Count = 1 Then
        ar = rng.Value
        For j = 1 To UBound(ar, 2)
            If ar(1, j) = "" Then n = n + 1
            If ar(1, j) <> "" Then demo = demo & Format(ar(1, j), "m/d") & ","
        Next
        If n = UBound(ar, 2) Then
            demo = ""
        Else
            demo = Left(demo, Len(demo) - 1)
        End If
    End If
End Function

但在汇总提取缺勤日期方面有点罗嗦,希望能简化显示为“起始日期~截止日期”

截图

截图


开始想是不是可以修改VBA内容加一条判断语句 If ar(1, j) +1=  ar(1, j+1)  then demo = ""

但是不行,貌似没这么简单,希望哪位大侠帮忙,万分感谢~!!!

月度缺勤汇总.rar (10.3 KB, 下载次数: 4)
发表于 2015-7-6 16:51 | 显示全部楼层
Sub test2()
    Dim A, B, i, t, x, y, z

    A = [j2].CurrentRegion
    ReDim B(1 To UBound(A) - 2, 1 To 1)

    For i = 3 To UBound(A)
        If Cells(i + 1, 12).End(xlToRight).Column <> Columns.Count Then
            Set x = Range(Cells(i + 1, 12), Cells(i + 1, 41)).SpecialCells(2)

            '遍历子区域
            For Each y In x.Areas
                '1)一个子区域
                For Each z In y
                    If y.Count = 1 Then
                        t = Format(z, "m/d")
                    Else
                        t = Format(z, "m/d") & "~" & Format(z + y.Count - 1, "m/d")
                    End If
                    Exit For
                Next

                '2)连接子区域
                B(i - 2, 1) = B(i - 2, 1) & "," & t
            Next

            B(i - 2, 1) = Mid(B(i - 2, 1), 2)
        End If
    Next i
    Range("f:f").NumberFormat = "m/d"
    [f4].Resize(UBound(B)) = B
End Sub


月度缺勤汇总2.rar (15.32 KB, 下载次数: 3)
回复

使用道具 举报

发表于 2015-7-6 16:54 | 显示全部楼层
本帖最后由 thinkersky 于 2015-7-6 16:56 编辑

Function demo(rng As Range)
    Dim j As Integer, n As Integer, k As Integer
    Dim dstart, dend
    If rng.Rows.Count = 1 Then
        ar = rng.Value
        For j = 1 To UBound(ar, 2)
            If ar(1, j) <> "" Then
                n = n + 1
                If n = 1 Then dstart = Format(ar(1, j), "m/d")
                dend = Format(ar(1, j), "m/d")
            End If
        Next
        If n = 0 Then demo = ""
        If dstart = dend Then
            demo = dstart
        Else
            demo = dstart & "~" & dend
        End If
    End If
End Function

月度缺勤汇总.zip

12.78 KB, 下载次数: 2

回复

使用道具 举报

 楼主| 发表于 2015-7-6 17:08 | 显示全部楼层
感谢二楼“爱疯”版主的热心帮助,是我想要的结果,但不是通过单元格=demo(L4:AO4)实现的。。。

也十分感谢三楼“thinkersky ”大侠,但结果却没有实现不连续的缺勤以“,”逗号分段。。。

纠结了呀~~!
回复

使用道具 举报

发表于 2015-7-6 17:13 | 显示全部楼层
月度缺勤汇总.rar (12.27 KB, 下载次数: 12)

点评

若6-20有出勤则出错  发表于 2015-7-6 18:22
回复

使用道具 举报

发表于 2015-7-6 18:20 | 显示全部楼层    本楼为最佳答案   
本帖最后由 zjdh 于 2015-7-6 18:26 编辑

Function demo(rng As Range)
    If rng.Rows.Count = 1 Then
        ar = rng.Resize(1, rng.Columns.Count + 1)
        If ar(1, 1) <> "" Then demo = demo & "," & Format(ar(1, 1), "m/d")
        For j = 2 To UBound(ar, 2)
            If ar(1, j) <> "" Then
                If ar(1, j) <> ar(1, j - 1) + 1 Then
                    demo = demo & "," & Format(ar(1, j), "m/d")
                ElseIf ar(1, j) <> ar(1, j + 1) - 1 Then
                    demo = demo & "~" & Format(ar(1, j), "m/d")
                End If
            End If
        Next
        demo = Replace(Mid(demo, 2), "-", "/")
    End If
End Function
月度缺勤汇总.rar (12.28 KB, 下载次数: 8)
回复

使用道具 举报

发表于 2015-7-6 18:30 | 显示全部楼层
本帖最后由 qh8600 于 2015-7-6 18:36 编辑
zjdh 发表于 2015-7-6 18:20
Function demo(rng As Range)
    If rng.Rows.Count = 1 Then
        ar = rng.Resize(1, rng.Columns. ...

区域往右扩大一个就可以了{:112:}
不过没有加1好,加1是正解
回复

使用道具 举报

发表于 2015-7-6 22:01 | 显示全部楼层
我知道扩大一列即可,但自定义函数的公式不应该这样处理。
回复

使用道具 举报

 楼主| 发表于 2015-7-6 23:05 | 显示全部楼层
谢谢”qh8600 “热心帮忙,更要谢谢”zjdh“大侠~你的答案堪称完美,无敌啊!!!!!!!

编个VBA真是逻辑性很强的活,一般初学入门学点皮毛像我这样的,

一碰到稍微复杂点的就脑子混乱了~~~呵呵

还好有楼上各位鼎力相助,万分感谢~!!

”zjdh“大侠的代码和逻辑思路,我还得消化一下
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-28 21:43 , Processed in 0.361434 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表