Скрыть последовательные значения в VBA

Question

вы можете предложить мне рутина - алгоритм в VBA, который может принимать следующие строки в качестве входных данных: «A14, A22, A23, A24, A25, A33» и превратить его к этому: «A14, A22 - A25, A33» ?

Спасибо

EDIT: Благодаря @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

Грубо Вы можете сделать это следующим образом.

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 

Answer 2

это должно сделать

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 3

Вот пример, показывающий, как можно скрыть последовательные значения с регулярным выражением:

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 

И выход: