Question

excel vba 代码或函数

1 1.5 2 2.5 3 3.5 4 4.5 结果

1 1 2,4.5

1 1 1 1 1 1 1 1 1~4.5

1 1 1 1.5~2.5

需求：
返回非空白单元格对应标题行的值
当标题行的值是连续的取首尾的值,中间用~号隔开
当标题行的值是不连续的,取对应的值,中间用,号隔开

vba 代码或函数都可以

感谢各位大侠！
主要是返回标题行值, 有连续的取首尾值中间用~连接, 不连续的用,连接
1 1.5 2 2.5 3 3.5 4 4.5 结果

1 1 1 1 1 1~2,3.5,4.5

Answer 1

在模块里面输入下列代码：

Function js(r)
    js = ""
    rg = Range("A1:H1").Value  '第一行数据所在区域
    For i = 1 To UBound(rg, 2)
        If Cells(r, i) <> "" Then js = js & rg(1, i) & ","
    Next
    js = Left(js, Len(js) - 1)
End Function

使用：在需要显示结果的地方输入 =js(ROW()) ，可下拉填充

追问

这个结果没有实现:当返回标题行的值是连续的, 则取首尾的值,中间用~号隔开 帮我再想想怎么实现,谢谢.

追答

Function js(r) 
    js = ""
    rg = Range("A1:H1").Value
    For i = 1 To UBound(rg, 2)
        If Cells(r, i) = "" Then rg(1, i) = ""
    Next
    For i = 1 To UBound(rg, 2)
        j = 0
        Do While rg(1, i + j) <> ""
            j = j + 1
            If i + j > UBound(rg, 2) Then Exit Do
        Loop
        j = j - 1
        If j > 1 Then  '3个及以上连续的，使用~，如果包括2个的，请改1为0
            js = js & rg(1, i) & "~" & rg(1, i + j) & ","
            i = i + j
        Else
            If rg(1, i) <> "" Then js = js & rg(1, i) & ","
        End If
    Next
    js = Left(js, Len(js) - 1)
End Function

Answer 2

只能是这样，I2=IF(A2<>"",A$1&",","")&IF(B2<>"",B$1&",","")&IF(C2<>"",C$1&",","")&IF(D2<>"",D$1&",","")&IF(E2<>"",E$1&",","")&IF(F2<>"",F$1&",","")&IF(G2<>"",G$1&",","")&IF(H2<>"",H$1,"")向下填充。

追问

谢谢,但这个结果也没实现:当返回标题行的值是连续的, 则取首尾的值,中间用~号隔开,不连续的用,号隔开

Answer 3

如果是1,1.5,2,3.5,4.5
结果是什么？

追问

1~2,3.5,4.5