Question

我一直在寻找一段代码，该代码可以在不使用正则表达式的情况下为我提供数字（我希望我的宏可以被任何人使用，特别是对非计算机友好的人）。这是动态创建图表等的代码创建系列代码的一小部分。
这是我正在处理的数据类型“ C23H120N5O4Cl”，因此我想将其保存在变量23中，然后将其保存在另一个120中，其余的都应该无关紧要（可能什么也不是）。我的数字可能在单个字符（C，H或其他字符）之间，但我需要在C和H之后的数字。所以现在这是我的代码：

  RangeOccupied = Range("C2").End(xlDown).row


  For i = 1 To RangeOccupied

    If i <> RangeOccupied Then

      'Look for digits after C

      pos = InStr(1, Cells(i + 1, 2), "C") + 1
      pos1 = InStr(pos, Cells(i + 1, 2), "H")
      NumC = Mid(Cells(i + 1, 2), pos, pos1 - pos)

      'Look for digits after H

      pos = InStr(1, Cells(i + 1, 2), "H") + 1
      pos1 = InStr(pos, Cells(i + 1, 2), "O")
      NumH = Mid(Cells(i + 1, 2), pos, pos1 - pos)
    End If
  Next

理想情况下，我希望pos1数字不依赖于特定字符而是任何字符。即拥有pos1=InStr(pos,Cells(i+1,2),"ANY NON-NUMBER CHARACTER")。

我不知道不使用正则表达式是否可能。

Answer 1

此函数将在文本字符串中返回数字字符串的数组

Option Explicit
Function myDigits(str As String) As String()
    Dim col As Collection
    Dim I As Long, S() As String

I = 0
Set col = New Collection
Do Until I > Len(str)
    I = I + 1
    If IsNumeric(Mid(str, I, 1)) Then
        col.Add Val(Mid(str, I, Len(str)))
        I = I + 1
        Do Until Not IsNumeric(Mid(str, I, 1))
            I = I + 1
        Loop
    End If
Loop

ReDim S(0 To col.Count - 1)
    For I = 1 To col.Count
        S(I - 1) = col(I)
    Next I
myDigits = S
End Function

Answer 2

编辑

已更改要使用的功能，并返回键dictionaries和"C"与其编号配对的"H"。包括下面的屏幕截图。

确保它可以处理棘手的情况，在这些棘手的情况下，多个字母相互叠放：

代码：

Sub mainLoop()

    Dim numbers As Scripting.Dictionary: Set numbers2 = New Scripting.Dictionary

    For i = 1 To 5
        Set numbers = returnDict(Cells(i, 1).Value)
        printout numbers, i
    Next

End Sub

Function returnDict(cellValue As String) As Scripting.Dictionary

    Dim i As Integer: i = 1
    Dim holder As String: holder = ""
    Dim letter As String

    Set returnStuff = New Scripting.Dictionary

    While i < Len(cellValue)
        If Mid(cellValue, i, 1) = "C" Or Mid(cellValue, i, 1) = "H" Then
            i = i + 1
            If IsNumeric(Mid(cellValue, i, 1)) Then
                letter = (Mid(cellValue, i - 1, 1))
                Do While IsNumeric(Mid(cellValue, i, 1))
                    holder = holder & Mid(cellValue, i, 1)
                    i = i + 1
                    If i > Len(cellValue) Then Exit Do
                Loop
                returnStuff.Add letter, holder
                holder = ""
            ElseIf Mid(cellValue, i, 1) <> LCase(Mid(cellValue, i, 1)) Then
                returnStuff.Add Mid(cellValue, i - 1, 1), "1"
            End If
        Else
            i = i + 1
        End If
    Wend
End Function

这是一个快速的小功能，用于打印dictionary

的内容

Sub printout(dict As Scripting.Dictionary, row As Integer)

    Dim i As Integer: i = 2

    For Each Key In dict.Keys
        Cells(row, i).Value = Key & ": " & dict.Item(Key)
        i = i + 1
    Next

End Sub

Answer 3

好的，我绝对可以确定有一种更有效的方法。但是我认为下面的示例可以很清楚地看出一种分离值的方法。

Option Explicit

Sub test()
    Dim testValues() As String
    Dim val1 As Long
    Dim val2 As Long

    testValues = Split("C23H120N5O4Cl,C23O120N5H4Cl,C4H120", ",")

    Dim testValue As Variant
    For Each testValue In testValues
        ExtractValues testValue, val1, val2
        Debug.Print "For " & testValue & ": " & val1 & " and " & val2
    Next testValue
End Sub

Public Sub ExtractValues(ByVal inString As String, _
                         ByRef output1 As Long, _
                         ByRef output2 As Long)
    Dim outString1 As String
    Dim outString2 As String
    Dim stage As String
    stage = "Begin"

    Dim thisCharacter As String
    Dim i As Long
    For i = 1 To Len(inString)
        thisCharacter = Mid$(inString, i, 1)
        Select Case stage
            Case "Begin"
                If thisCharacter = "C" Then stage = "First Value"

            Case "First Value"
                If (Asc(thisCharacter) >= Asc("0")) And _
                   (Asc(thisCharacter) <= Asc("9")) Then
                    outString1 = outString1 & thisCharacter
                Else
                    '--- if we get here, we're done with this value
                    output1 = CLng(outString1)

                    '--- verify the next character is the "H"
                    If thisCharacter = "H" Then
                        stage = "Second Value"
                    Else
                        stage = "Next Value"
                    End If
                End If

            Case "Next Value"
                If thisCharacter = "H" Then stage = "Second Value"

            Case "Second Value"
                If (Asc(thisCharacter) >= Asc("0")) And _
                   (Asc(thisCharacter) <= Asc("9")) Then
                    outString2 = outString2 & thisCharacter
                Else
                    '--- if we get here, we're done with this value
                    output2 = CLng(outString2)
                    stage = "Finished"
                    Exit For
                End If
        End Select
    Next i

    If Not (stage = "Finished") Then
        output2 = CLng(outString2)
    End If
End Sub

Answer 4

这是比我的第一个解决方案更通用，更有效的方法。这种方法使用一个函数来提取给定子字符串后面的数字-在这种情况下，它是单个字母“ C”或“ H”。该函数还考虑了位于输入值末尾的值。

Option Explicit

Sub test()
    Dim testValues() As String
    Dim val1 As Long
    Dim val2 As Long

    testValues = Split("C23H120N5O4Cl,C23O120N5H4Cl,C4H120", ",")

    Dim testValue As Variant
    For Each testValue In testValues
        val1 = NumberAfter(testValue, "C")
        val2 = NumberAfter(testValue, "H")
        Debug.Print "For " & testValue & ": " & val1 & " and " & val2
    Next testValue
End Sub

Private Function NumberAfter(ByVal inString As String, _
                             ByVal precedingString As String) As Long
    Dim outString As String
    Dim thisToken As String
    Dim foundThisToken As Boolean
    foundThisToken = False

    Dim i As Long
    For i = 1 To Len(inString)
        thisToken = Mid$(inString, i, 1)
        If thisToken = precedingString Then
            foundThisToken = True
        ElseIf foundThisToken Then
            If thisToken Like "[0-9]" Then
                outString = outString & thisToken
            Else
                Exit For
            End If
        End If
    Next i
    NumberAfter = CLng(outString)
End Function

Answer 5

我从这里Extract numbers from chemical formula

找到了这个解决方案

Public Function ElementCount(str As String, element As String) As Long
    Dim i As Integer
    Dim s As String

    For i = 1 To 3
        s = Mid(str, InStr(str, element) + 1, i)
        On Error Resume Next
        ElementCount = CLng(s)
        On Error GoTo 0
    Next i
End Function

这是可行的，但是如果将像CH4这样的简单分子放进去，那是行不通的，因为没有显示数字...但是我（我们）可能可以解决这个问题。

再次感谢您提供的所有解决方案！

编辑：

这是我使用的功能，我认为它考虑了所有可能的情况！再次感谢您的帮助！

Public Function ElementCount(str As String, element As String) As Long
    Dim k As Integer
    Dim s As String

    For k = 1 To Len(str)

        s = Mid(str, InStr(str, element) + 1, k)

        On Error Resume Next
        ElementCount = CLng(s)
        On Error GoTo 0

        If InStr(str, element) > 0 And ElementCount = 0 Then

           ElementCount = 1

        End If
    Next k

End Function

Answer 6

我的2c：

Sub tester()
    Dim r, arr, v
    arr = Array("C", "Z", "Na", "N", "O", "Cl", "Br", "F")
    For Each v In arr
        Debug.Print v, ParseCount("C15H12Na2N5O4ClBr", v)
    Next v
End Sub

Function ParseCount(f, s)

    Const ALL_SYMBOLS As String = "Ac,Al,Am,Sb,Ar,As,At,Ba,Bk,Be,Bi,Bh,Br,Cd,Ca,Cf,Ce,Cs,Cl," & _
     "Cr,Co,Cn,Cu,Cm,Ds,Db,Dy,Es,Er,Eu,Fm,Fl,Fr,Gd,Ga,Ge,Au,Hf,Hs,He,Ho,In,Ir,Fe,Kr,La,Lr," & _
     "Pb,Li,Lv,Lu,Mg,Mn,Mt,Md,Hg,Mo,Mc,Nd,Ne,Np,Ni,Nh,Nb,No,Og,Os,Pd,Pt,Pu,Po,Pr,Pm,Pa,Ra," & _
     "Rn,Re,Rh,Rg,Rb,Ru,Rf,Sm,Sc,Sg,Se,Si,Ag,Na,Sr,Ta,Tc,Te,Ts,Tb,Tl,Th,Tm,Sn,Ti,Xe,Yb,Zn," & _
     "Zr,B,C,F,H,I,N,O,P,K,S,W,U,V,Y"

    Dim atoms, rv, pos, i As Long
    atoms = Split(ALL_SYMBOLS, ",")

    rv = 0 'default return value

    If IsError(Application.Match(s, atoms, 0)) Then
        rv = -1        'not valid atomic symbol
    Else
        i = 1
        pos = InStr(i, f, s, vbBinaryCompare)
        If pos > 0 Then
            If Len(s) = 2 Then
                'should be a true match...
                rv = ExtractNumber(f, pos + 2)
            ElseIf Len(s) = 1 Then
                'check for false positives eg "N" matches on "Na"
                Do While pos > 0 And Mid(f, pos + 1, 1) Like "[a-z]"
                    i = pos + 1
                    pos = InStr(i, f, s, vbBinaryCompare)
                Loop
                If pos > 0 Then rv = ExtractNumber(f, pos + 1)
            Else
                'exotic chemistry...
            End If
        End If
    End If
    ParseCount = rv
End Function

'extract consecutive numeric digits from f starting at pos
' *returns 1 if no number present*
Function ExtractNumber(f, pos)
    Dim rv, s, i As Long
    Do While (pos + i) <= Len(f)
        If Not Mid(f, pos + i, 1) Like "#" Then Exit Do
        i = i + 1
    Loop
    ExtractNumber = IIf(i = 0, 1, Mid(f, pos, i))
End Function

不使用正则表达式查找两个字符之间的数字

6 个答案: