Question

我正在尝试将大量数据转换为文本的书面说明。例如将YYYY #######转换为“ 4位数字，7位数字”，将YYMMDD-####转换为“ 2位数字，2位数字，2位数字，连字符，4位数字”

常量字符为Y，M，D，＃，-和X（X表示未定义的字母字符）。有一些已定义的字母字符（Y，M，D和X从未分别用于除Year，Month，Day和Alpha之外的其他任何东西），即我想尝试的（RP-YYYY #####）捕获这些字符（常量字符以外的任何字符）并按原样声明它们。因此，RP-YYYY #####的书面文字应为“ RP，hypen，4位数字年份，5位数字”

我可以使用Len和Replace方法获得每个字符的计数，但是我正在努力弄清楚如何以正确的顺序生成书面文本，或者捕获非恒定字符，例如RP和state他们原样。

任何帮助将不胜感激！

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

您可以使用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

Answer 2

这似乎可以满足您的要求。

如所写，它假定[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

将字符串字符转换为文本

2 个答案: