Преобразовать строковые символы в текст

Question

Я пытаюсь преобразовать большое количество данных в письменное описание текста.Ex.Преобразовать YYYY ####### в «4-значный год, 7 цифр» и YYMMDD - #### в «2-значный год, 2-значный месяц, двухзначный день, дефис, 4 цифры»

Постоянными символами являются Y, M, D, #, - и X (X для неопределенных буквенных символов).Есть некоторые определенные буквенные символы (Y, M, D и X никогда не используются для чего-либо кроме Год, Месяц, День и Альфа соответственно), которые используются, то есть (RP-YYYY #####), где я хочу попробоватьчтобы захватить их (что угодно, кроме константных символов) и указать их как они естьТаким образом, письменный текст для RP-YYYY ##### будет "RP, hypen, 4-значный год, 5-значный номер"

Я могу получить количество каждого символа, используя Len и Replaceметоды, однако я изо всех сил пытаюсь выяснить, как создать письменный текст в правильном порядке, или захватить непостоянные символы, такие как RP, и сформулировать их как есть.

Любая помощь будет высоко ценится!

Sub getcharacters()
Dim casenumber As String

casenumber = Range("A1")
InitialCount = Len(casenumber)
YearDigits = Len(casenumber) - Len(Replace(casenumber, "Y", ""))
MonthDigits = Len(casenumber) - Len(Replace(casenumber, "MM", ""))
DayDigits = Len(casenumber) - Len(Replace(casenumber, "DD", ""))
NumberDigits = Len(casenumber) - Len(Replace(casenumber, "#", ""))
AlphaDigits = Len(casenumber) - Len(Replace(casenumber, "X", ""))
HyphenDigits = Len(casenumber) - Len(Replace(casenumber, "-", ""))
FinalCount = InitialCount - YearDigits - MonthDigits - DayDigits - Digits - AlphaDigits

If YearDigits = "0" Then WrittenYear = ""
If YearDigits = "2" Then WrittenYear = "Two digit year"
If YearDigits = "4" Then WrittenYear = "Four digit year"
If MonthDigits = "0" Then WrittenMonth = "" Else WrittenMonth = "Two digit month"
If DayDigits = "0" Then WrittenDay = "" Else WrittenDay = "Two digit day"
If NumberDigits = "0" Then WrittenDigits = "" Else WrittenDigits = NumberDigits & " digits"
If AlphaDigits = "0" Then WrittenAlpha = "" Else WrittenAlpha = AlphaDigits & " alpha characters"
WrittenCaseNumber = WrittenYear & WrittenMonth & WrittenDay & WrittenDigits & WrittenAlpha
End Sub

Answer 1

Это, кажется, выполняет то, что вы хотите.

Как написано, предполагается, что все "похожие" символы в наборе [YMD #] являются смежными.Если, например, группы из Y могут повторяться в разных частях строки, нам просто нужно изменить функцию charCnt.

Option Explicit
'set reference to Microsoft Scripting Runtime
Function convStr(S As String) As String
    Dim myDict As Dictionary
    Dim sRes() As String
    Dim I As Long
    Dim CH As String

Set myDict = New Dictionary
    myDict.CompareMode = TextCompare

    myDict.Add "Y", "digit year"
    myDict.Add "M", "digit month"
    myDict.Add "D", "digit day"
    myDict.Add "#", "numeric digits"
    myDict.Add "-", "hyphen"

ReDim sRes(0)
For I = 1 To Len(S)
    CH = Mid(S, I, 1)
    If myDict.Exists(CH) Then
        sRes(UBound(sRes)) = IIf(CH <> "-", charCnt(S, CH) & " ", "") & myDict(CH)
        I = I + charCnt(S, CH)
    Else
        Do While Not myDict.Exists(CH)
            sRes(UBound(sRes)) = sRes(UBound(sRes)) & CH
            I = I + 1
            CH = Mid(S, I, 1)
        Loop
    End If

I = I - 1
ReDim Preserve sRes(UBound(sRes) + 1)
Next I

ReDim Preserve sRes(UBound(sRes) - 1)

convStr = Join(sRes, ", ")

End Function

Function charCnt(S As String, CH As String) As Long
    Dim startChar As Long
startChar = InStr(S, CH)

If startChar > 0 Then
    charCnt = Len(S) - Len(Replace(S, CH, ""))
Else
    charCnt = 0
End If

End Function

Answer 2

Вы можете использовать Regex для сопоставления и замены деталей, а также некоторые вспомогательные функции для преобразования цифр в слова и т. Д. Я признаю, что это немного уродливо, но это помогает.

Сначала добавьте следующие двассылки на ваш проект:

• Регулярные выражения Microsoft VBScript 5.5
• Среда выполнения сценариев Microsoft

Во-вторых, добавьте следующий код в модуль:

Option Explicit

Private DictAlphaCharacters As Scripting.Dictionary

Private Sub InitializeDictAlphaCharacters()
    Set DictAlphaCharacters = New Scripting.Dictionary
    DictAlphaCharacters.Add "Y", "digit year"
    DictAlphaCharacters.Add "M", "digit month"
    DictAlphaCharacters.Add "D", "digit day"
    DictAlphaCharacters.Add "#", "numeric digits"
End Sub

Public Function DescribeThis(s As String) As String
    If DictAlphaCharacters Is Nothing Then InitializeDictAlphaCharacters

    Dim tmpStr As String: tmpStr = s

    Dim regEx As New RegExp
    regEx.Global = True
    Dim matches As MatchCollection
    Dim m As Match

    Dim k As Variant        ' Dictionary key.
    Dim alpha As String     ' The corresponding sentence for an alpha char.
    Dim l As Integer        ' Length of the matched string (consecutive alpha chars).
    Dim w As String         ' The corresponding word of a digit.

    For Each k In DictAlphaCharacters.Keys
        alpha = DictAlphaCharacters.Item(k)
        regEx.Pattern = k & "{1,9}"
        Set matches = regEx.Execute(tmpStr)
        For Each m In matches
            l = m.Length
            w = DigitToWord(l)
            ' Pattern ex. = "([^Y])?,?Y{2}(?!Y)"
            regEx.Pattern = "([^" & k & "])?,?" & k & "{" & l & "}(?!" & k & ")"
            '         Replacement example: "$1,Two digit year,"
            tmpStr = regEx.Replace(tmpStr, "$1," & w & " " & alpha & ",")
        Next
    Next

    regEx.Pattern = ",?-,?"
    tmpStr = regEx.Replace(tmpStr, ",hyphen,")

    regEx.Pattern = "^,+|,+$"
    DescribeThis = regEx.Replace(tmpStr, "")
End Function

Public Function DigitToWord(d As Integer) As String
    Select Case d
        Case 1: DigitToWord = "One"
        Case 2: DigitToWord = "Two"
        Case 3: DigitToWord = "Three"
        Case 4: DigitToWord = "Four"
        Case 5: DigitToWord = "Five"
        Case 6: DigitToWord = "Six"
        Case 7: DigitToWord = "Seven"
        Case 8: DigitToWord = "Eight"
        Case 9: DigitToWord = "Nine"
    End Select
End Function

Использование:

Sub Test()
    Debug.Print DescribeThis("YYYY#######")
    Debug.Print DescribeThis("YYMMDD-####")
    Debug.Print DescribeThis("RP-YYYY#####")
    Debug.Print DescribeThis("YYYMMM-YYMM")
End Sub

Выход:

Four digit year,Seven numeric digits
Two digit year,Two digit month,Two digit day,hyphen,Four numeric digits
RP,hyphen,Four digit year,Five numeric digits
Three digit year,Three digit month,hyphen,Two digit year,Two digit month