隐藏VBA中的顺序值

Question

你可以建议我在VBA中使用以下String作为输入的例程 - 算法： “A14，A22，A23，A24，A25，A33” 把它变成这个： “A14，A22 - A25，A33” ？

谢谢

修改 感谢@omegastripes

Sub Test()
    Dim strText, strRes, strTail, i
    Dim comma     As String: comma = ", "
    Dim dash      As String: dash = "-"
    Dim delimiter As String
    Dim counter   As Integer

    strText = "A14, A22, A23, A24, A25, A26, A33, A34"
    strRes = ""
    strTail = ""
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "([a-zA-Z])(\d+)"
        With .Execute(strText)
            strRes = .Item(0).Value
            For i = 1 To .Count - 1
                If (.Item(i).SubMatches(0) = .Item(i - 1).SubMatches(0)) And (.Item(i).SubMatches(1) - .Item(i - 1).SubMatches(1) = 1) Then
                    counter = counter + 1
                    If counter > 1 Then
                        delimiter = dash
                    Else
                        delimiter = comma
                    End If
                    strTail = delimiter & .Item(i).SubMatches(0) & .Item(i).SubMatches(1)
                Else
                    Debug.Print "strRes: " & strRes & ", " & "strTail: " & strTail & ", " & .Item(i).SubMatches(1)
                    strRes = strRes & strTail & ", " & .Item(i).SubMatches(0) & .Item(i).SubMatches(1)
                    strTail = ""
                    counter = 0
                End If
            Next
            strRes = strRes & strTail
        End With
    End With

    MsgBox strText & vbCrLf & strRes

End Sub

Answer 1

这应该做

Function HideValues(inputStrng As String) As String
    Dim outputStrng As String, iniLetter As String, endLetter As String
    Dim vals As Variant, val As Variant
    Dim iVal As Long, iniVal As Long, endVal As Long, diffVal As Long

    vals = Split(WorksheetFunction.Substitute(inputStrng, " ", ""), ",")
    iVal = 0
    Do While iVal < UBound(vals)
        iniVal = getValNumber(vals(iVal), iniLetter)
        endVal = getValNumber(vals(iVal + 1), endLetter)
        If iniLetter = endLetter Then
            diffVal = 1
            Do While endVal = iniVal + diffVal And iVal < UBound(vals) - 1
                diffVal = diffVal + 1
                iVal = iVal + 1
                endVal = getValNumber(vals(iVal + 1), endLetter)
            Loop
            If diffVal > 1 Then
                If iVal = UBound(vals) - 1 Then If endVal = iniVal + diffVal Then iVal = iVal + 1: diffVal = diffVal + 1
                outputStrng = outputStrng & vals(iVal - diffVal + 1) & " - " & vals(iVal) & ","
            Else
                outputStrng = outputStrng & vals(iVal) & ","
            End If
        Else
            outputStrng = outputStrng & vals(iVal) & ","
        End If
        iVal = iVal + 1
    Loop
    If iVal = UBound(vals) Then outputStrng = outputStrng & vals(iVal) & ","
    HideValues = WorksheetFunction.Substitute(Left(outputStrng, Len(outputStrng) - 1), ",", ", ")
End Function


Function getValNumber(val As Variant, letter As String) As Long
    Dim strng As String
    Dim i As Long

    strng = CStr(val)
    For i = 1 To Len(strng)
         If Mid(strng, i, 1) Like "[0-9]" Then Exit For
    Next i
    letter = Left(strng, i - 1)
    getValNumber = CLng(Right(strng, Len(strng) - i + 1))
End Function

我测试了以下内容：

Sub main()
    Dim inputStrng As String

    inputStrng = "A21, B22, C23, D24, E25, F26"
    MsgBox inputStrng & vbCrLf & vbCrLf & "becomes" & vbCrLf & vbCrLf & HideValues(inputStrng)

    inputStrng = "A21, A22, A23, A24, A25, A26"
    MsgBox inputStrng & vbCrLf & vbCrLf & "becomes" & vbCrLf & vbCrLf & HideValues(inputStrng)

    inputStrng = "A21, A22, A23, A24, A25, A33" '
    MsgBox inputStrng & vbCrLf & vbCrLf & "becomes" & vbCrLf & vbCrLf & HideValues(inputStrng)

    inputStrng = "A14, A22, A23, A24, A25, A33"
    MsgBox inputStrng & vbCrLf & vbCrLf & "becomes" & vbCrLf & vbCrLf & HideValues(inputStrng)

    inputStrng = "A14, A22, A23, A24, A25, A26"
    MsgBox inputStrng & vbCrLf & vbCrLf & "becomes" & vbCrLf & vbCrLf & HideValues(inputStrng)
End Sub

Answer 2

以下示例说明如何使用正则表达式隐藏顺序值：

Option Explicit

Sub Test()

    Dim strText, strRes, strTail, i

    strText = "A14, A22, A23, A24, A25, A33"
    strRes = ""
    strTail = ""
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "([a-zA-Z])(\d+)"
        With .Execute(strText)
            strRes = .Item(0).Value
            For i = 1 To .Count - 1
                If (.Item(i).SubMatches(0) = .Item(i - 1).SubMatches(0)) And (.Item(i).SubMatches(1) - .Item(i - 1).SubMatches(1) = 1) Then
                    strTail = "-" & .Item(i).SubMatches(0) & .Item(i).SubMatches(1)
                Else
                    strRes = strRes & strTail & ", " & .Item(i).SubMatches(0) & .Item(i).SubMatches(1)
                    strTail = ""
                End If
            Next
            strRes = strRes & strTail
        End With
    End With

    MsgBox strText & vbCrLf & strRes

End Sub

输出：

Answer 3

大概你可以这样做。

Sub Way()
Dim str1 As String
Dim cet As variant
Dim str2 As String

str1 =  "A14, A22, A23, A24, A25, A33"
cet = split(str1, ",")

if len(join(cet)) > 2 then
    str2 = cet(0) & "," & cet(1) & "-" & cet(Ubound(cet)-1) & "," & cet(ubound(cet))
End if

debug.Print str2
End Sub