在 Vba Excel 中汇总文本的函数

香蕉

现在我正在使用 MS Excel 2019。我希望创建函数以从步骤和值列的摘要步骤列和摘要值列获取文本,它被描述为这张照片

我试过这个功能。但是,它根本不起作用

Function Congdoan_Time(Congdoan As Range, Time As Range, gtri As Boolean) As String

Dim xValue, TimeValue As String
Dim xChar As String
Dim xOutValue, xTimeValue As String

xValue = Congdoan.Value
TimeValue = Time.Value
Dim arr, timearr As Variant
Dim text, texttime As String
Dim nextarr As Variant
arr = Split(xValue, ",")
timearr = Split(TimeValue, "-")
Dim i As Long
Dim vallue As Variant
vallue = timearr(0)
  For i = LBound(arr) To UBound(arr) - 1
        If arr(i) = arr(i + 1) And i < UBound(arr) - 1 Then
        vallue = Val(vallue) + Val(timearr(i + 1))
         End If
        If arr(i) = arr(i + 1) And i = UBound(arr) - 1 Then
         End If
         If arr(i) <> arr(i + 1) Then
         xOutValue = xOutValue & "," & arr(i)
         xTimeValue = xTimeValue & "-" & vallue
        vallue = Val(timearr(i + 1))
        End If
    Next i

If xOutValue = "" Then
xOutValue = Join(arr, ",")
xTimeValue = vallue
End If

text = Right(xOutValue, Len(xOutValue) - 1)
nextarr = Split(text, ",")
If arr(UBound(arr)) <> nextarr(UBound(nextarr)) Then
text = text & "," & arr(UBound(arr))
xTimeValue = xTimeValue & "-" & Val(vallue) + Val(timearr(UBound(arr)))

End If
If gtri = True Then
Congdoan_Time = text
Else
Congdoan_Time = xTimeValue
End If
End Function

Sumary Steps 列中的公式点击这里

在汇总值列点击这里

请帮助制作另一个对我有用的功能谢谢

合资公司

我使用字典的两分钱:

Function Summary(steps As String, vals As String, pick As Boolean) As String

Dim arr_steps As Variant, arr_vals As Variant
Dim new_steps() As Variant, new_vals() As Variant

arr_steps = Split(steps, ",")
arr_vals = Split(vals, "-")

ReDim new_steps(UBound(arr_steps))
ReDim new_vals(UBound(arr_steps))

For x = 0 To UBound(arr_steps)
    If x = 0 Then
        new_steps(x) = arr_steps(x)
        new_vals(x) = arr_vals(x)
    ElseIf arr_steps(x) = arr_steps(x - 1) Then
        new_vals(x) = CDbl(new_vals(x - 1)) + CDbl(arr_vals(x))
        new_vals(x - 1) = ""
    Else
        new_steps(x) = arr_steps(x)
        new_vals(x) = arr_vals(x)
    End If
Next

If pick Then
    Summary = Join(new_steps, ",")
Else
    Summary = Join(new_vals, "-")
End If

With CreateObject("VBScript.RegExp")
    .Global = True
    .Pattern = "(?:^-+|[-,]+([-,])|,+$)"
    Summary = .Replace(Summary, "$1")
End With

End Function

在此处输入图像描述

中的公式C1

=Summary(A1,B1,1)

中的公式D1

=Summary(A1,B1,0)

注意:我的语言环境使用十进制逗号而不是点。如果您使用的是点,它应该可以正常工作。我只需要在输入中更改这些。

本文收集自互联网,转载请注明来源。

如有侵权,请联系 [email protected] 删除。

编辑于
0

我来说两句

0 条评论
登录 后参与评论

相关文章