Arrays 在VBA中隐藏顺序值

你能给我推荐一个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

---

大致上你可以这样做

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

这应该可以

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

---

下面是一个示例，演示如何使用正则表达式隐藏顺序值：

选项显式
子测试（）
Dim strText、strRes、strTail、i
strText=“A14、A22、A23、A24、A25、A33”
strRes=“”
strTail=“”
使用CreateObject（“VBScript.RegExp”）
.Global=True
.Pattern=“（[a-zA-Z]）（\d+”
With.Execute（strText）
strRes=.Item（0）.Value
对于i=1到。计数-1
如果（.Item（i）.SubMatches（0）=.Item（i-1）.SubMatches（0））和（.Item（i）.SubMatches（1）-.Item（i-1）.SubMatches（1）=1），则
strTail=“-”和项目（i）.子匹配（0）和项目（i）.子匹配（1）
其他的
strRes=strRes&strTail&“，”和.Item（i）.子匹配（0）和.Item（i）.子匹配（1）
strTail=“”
如果结束
下一个
STRES=STRES和strTail
以
以
MsgBox strText&vbCrLf&strRes
端接头

以及输出：

---

感谢您的即时回复，但如果有两个以上的连续值，我会这样做。这非常有效，但仅适用于这个特定的示例。您可以尝试正则表达式和循环匹配，将每个匹配与以前的匹配进行比较，以便在间隔内跳过相邻的元素。@michalis:完成了吗？是的！非常感谢，不客气。如果我填好了你的问题，请将答案标记为已接受。谢谢对不起，我迟到了。谢谢你的回复！对于只有两个连续值的情况（例如A33、A34，我们不想成为A33-A44），我做了一个小改动。我把零钱寄出去了。@michalis希望你注意到这个细节）

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