arrays - 在 VBA 中隐藏连续值

Question

你能给我推荐一个 VBA 中的例程 - 算法吗，它可以将以下字符串作为输入: “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