如何用 "CamelCase" 和数字分隔 excel vba 中的文本

How do you separate text in excel vba by "CamelCase" and numbers

我正在尝试制作一个分子组成计算器,但我似乎可以将公式按大小写和数字分隔到不同的单元格中。

是否可以在 excel 中执行此操作?

例如:

Cl2HO   ----> Cl  |  2  |   H |    0 

如果您熟悉 VBA,那么您可以编写一个函数来读取单元格值(例如 Cl2H0),然后使用 For 循环将字符串拆分为单独的值。然后,您可以将这些单独的值(Cl、2、H 和 0)写回 excel sheet.

上的单独列

这样做的一种方法是在循环中使用 Asc() 函数,它会为您提供对应于单个字符的 Ascii 数字。 Ascii 字符 65 到 90 是大写字符。在您的情况下,您可能希望在字符不在此范围内时拆分字符串。

如果您想尝试这个和 post 您的示例,那么我可以提供更多指导,但是如果您试图通过 VBA 或其他一些手段。

有点粗糙,但是你可以写一个像这样的解析函数 returns 一个数组:

Public Function parseChem(str As String) As Variant()
  'should error-check first that entire string is correct

  Dim retArr() As Variant
  Dim i As Long, numBlocks As Long
  Dim currentChar As String, currentElement As String, typeOfChar As String
  Dim digitChain As Boolean

  For i = 1 To Len(str)
        currentChar = Mid(str, i, 1)
        typeOfChar = charType(currentChar)
        Select Case typeOfChar
              Case Is = "upperCase"
                    If currentElement <> "" Then
                          'possibly cast numbers to longs here, and at the end...
                          retArr(numBlocks) = currentElement
                    End If
                    numBlocks = numBlocks + 1
                    ReDim Preserve retArr(1 To numBlocks)
                    currentElement = currentChar
                    digitChain = False
              Case Is = "lowerCase"
                    currentElement = currentElement & currentChar
              Case Is = "digit"
                    If digitChain Then
                          currentElement = currentElement & currentChar
                    Else
                          'new digit block
                          retArr(numBlocks) = currentElement
                          numBlocks = numBlocks + 1
                          ReDim Preserve retArr(1 To numBlocks)
                          digitChain = True
                          currentElement = currentChar
                    End If
              Case Else
                    'do something to flag error
        End Select
  Next i

  retArr(numBlocks) = currentElement

  parseChem = retArr
End Function

Private Function charType(str As String) As String
  Dim ascii As Long
  ascii = Asc(str)
  If ascii >= 65 And ascii <= 90 Then
        charType = "upperCase"
        Exit Function
  Else
        If ascii >= 97 And ascii <= 122 Then
              charType = "lowerCase"
              Exit Function
        Else
              If ascii >= 48 And ascii <= 57 Then
                    charType = "digit"
                    Exit Function
              End If
        End If
  End If
End Function

OK最后算法很简单

If at any point in the formula you have a number, then look for the next capital letter and output all characters up to that point.

If at any point in the formula you have a letter, then look for the next capital letter *or number* and output all characters up to that point.

公式比较长

=IF(ISNUMBER(MID($A,SUM(LEN($B:B1))+1,1)+0),
MID(MID($A,SUM(LEN($B:B1))+1,9),1,MIN(FIND( MID("ABCDEFGHIJKLMNOPQRSTUVWXYZ",ROW(:),1),MID($A,SUM(LEN($B:B1))+2,9)&"ABCDEFGHIJKLMNOPQRSTUVWXYZ"  ))),
MID(MID($A,SUM(LEN($B:B1))+1,9),1,MIN(FIND( MID("ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789",ROW(:),1),MID($A,SUM(LEN($B:B1))+2,9)&"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"  ))))

必须使用 CtrlShiftEnter 作为数组公式输入,而 9 将如果公式超过 9 个字符,则需要增加(或更改为 len($a1) )。

这是一个较短的版本,不必作为数组公式输入

=IF(ISNUMBER(MID($A1,SUMPRODUCT(LEN($B1:B1))+1,1)+0),
MID(MID($A1,SUMPRODUCT(LEN($B1:B1))+1,9),1,AGGREGATE(15,6,FIND( MID("ABCDEFGHIJKLMNOPQRSTUVWXYZ",ROW(:),1),MID($A1,SUMPRODUCT(LEN($B1:B1))+2,9)&"A" ),1)),
MID(MID($A1,SUMPRODUCT(LEN($B1:B1))+1,9),1,AGGREGATE(15,6,FIND( MID("ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789",ROW(:),1),MID($A1,SUMPRODUCT(LEN($B1:B1))+2,9)&"A"),1)))