Question

Private Sub btnsubmit_Click()

Dim Msg As String
Dim pos1 As Integer
Dim pos2 As Integer
Dim Count As Integer
Dim flag As Integer
Dim telphno    

Msg = TextBox1.Value
pos1 = 1
pos2 = 1

flag = 0

Do While pos1 < Len(Msg)

    pos1 = InStr(pos1, Msg, "[")
    If flag = 0 Then
        pos2 = InStr(pos2, Msg, "]")
    End If

    If pos2 - pos1 < 5 Then
        ActiveCell.Value = Mid(Msg, pos1 + 1, pos2 - pos1 - 1)        
        Count = 0

        'Loop through the entire string
        For i = pos2 To Len(Msg)

            'Check to see if the character is a numeric one
            If IsNumeric(Mid(Msg, i, 1)) Then

                'Add it to the answer
                telphno = telphno + Mid(Msg, i, 1)
                Count = Count + 1                    

                'Check to see if we have reached 10 digits
                If Count = 10 Then Exit For                        

            Else
                telphno = ""
                Count = 0                
            End If

        Next i

        ActiveCell.Offset(0, 1).Value = telphno
        flag = 0
        ActiveCell.Offset(1, 0).Select
        pos1 = pos2 + 1
        pos2 = pos1
        telphno = ""        
    Else
        flag = 1
        pos1 = pos1 + 1            
  End If

Loop

End Sub

我正在尝试取出＆＃34; [＆＃34;和＆＃34;]＆＃34;在我的字符串但MID函数给我错误。请帮我解决这个问题。

找到＆＃34; [＆＃34;和＆＃34;]＆＃34;我正在寻找最接近的10位数字。我正在通过TextBox（用户输入）获取字符串。并在Excel Sheet上打印输出。

对于ex-

[A22]1239163332bcfhds[B23]6453jhddf2784637281ajdnjda[C33]dksamkd1288776655

对于上面的字符串。它应该给 -

A22 1239163332  
B23 2784637281
C33 1288776655

输入2 -

@ﬁJaeasaﬁGpaaaaod [A1] # 42, 5532 23156 “63’ 8:355 dedmaa @656 663336, {33538365. sail & as" 53666 wee—9008799499. @dﬁs.ée.maae06 [A2] S/O éegddad mweeﬁ @dﬁE aaseaeﬁ mwaossae We" ﬂees?) all 359% as" ﬁdee, wee—9886557596. $036903: WI 29365 amass @aoﬂae maﬁa] (me) sail was?“ asllmairid’, aha—9945173528. @6066 60333305 2:056. [A4] £06333 messes $6503.91: 33:12:05 mews. 8.133133% a?" aiding as" mamas. aha-9886444737. [50%. memergﬁos, [A5] mew 89335365 mamas. mama. aan wage, as" eagdade, diam—9731742667. eaaiodﬁaas. [A6] ge Wagﬁegd mwaoﬁsae maﬁa) £3966.maﬁa).sail mg"), as" mairiﬁ, met—9986611558. @8396 30653236 [A7] ﬂeas $839395 ﬂeas# 4138/38, Sgéegd 33905:,623 ﬁnaSeag soomrf,ao.&.&.‘w’ea§ss,$3913.29. ﬁdeaas 6:312:36,anaemia.all dog as" macaw-36,mom—9448166197.mamas 8985305 [A8192 ageng mews sambaaadeﬁaeﬁéﬁeo.all adswsg, all warm,dam—9945363102.@69535 games [A9]amasssesame@06.ao.&.dsaec56maisaﬁd.aall $33.19 as" mamrid’,wag—9844644272.as.demam] 33mmadésada.Gall 836%62, as" $3668, wee:—8.839%:ngge [imam meme $36033“ﬂaccid weave.mweaﬁd.all 623; as" maiarid,dam—9481161243.agodaé.8.ao.129330556 agaossae53%;.a?" & as" 5365366,mez—990187114-1.8884232296@2353e65@55.@05.9:330:36 @9033“we ems aim-.1353,swag.all 666663, as" maladdwag—8123565686.gang-56$60506 masses ﬁaoﬁaemaﬁﬂeas mews,swag.all 8665383, as" mdwﬁd aha—9845781954.[A10][A11][A12][A13][A14]$63535 3:633:56 [A15]@663 aaaaaeﬁ SawadJaeawe: aa£eas€ mews,{3368366.sail 6.9% all 0369966,dam—9945707587eaoadﬁ mesmereaa’cﬁwsl6:36:38 agaoisaeﬁasﬁewéédaall 303:3, as" 03653613,dam-9900436152.$830335eiedaﬁ $885366 Qawaeeiapﬂsaecss,asasdne.aall wipe, as" 53566,Elma—9448218974.$69836 memergﬁos [A18]# 167,“&oa5555”15’ 2:336, 63:: @55,deg-353255 9:355 acme-3%,massariﬁ.aall 3.3.333 as” nae-36386,WEE—9342495800.@%§ mewaergﬁcs [A19]# 794/8 oomﬁeo.modes mews,65366666.all 6333 as" mwwﬁ'ﬁ,dam—9945434802.$830535 Meme®$cs [A20]@30335 masses Mathewsmandaoddwsg.sail ﬁne]; as" 53538363,met-9980170633.@506 memergaos903361103: $358365 Saaawsae3536333.Ball 36335623, as" $368966,Wei-9972675782[A17] [A21]

预期输出 -

A1 9008799499
A2 9886557596
A4 9886444737
A5 9731742667
A6 9986611558
A7 9448166197
直到
A20 9980170633

Answer 1

你的代码是＆＃34;尖叫＆＃34;有关RegEx的使用，请参阅下面的代码（代码注释中的解释）。

子btnsubmit 代码

Option Explicit

Private Sub btnsubmit_Click()

Dim Msg As String
Dim pos1 As Integer
Dim pos2 As Integer
Dim posDelta As Integer
Dim telphno
Dim i As Integer

' added these 2 variables
Dim insideBrackets As String
Dim telphnoPos As Integer

TextBox1.Value = Sheets("sheet2").Range("H5").Value
Msg = TextBox1.Value

pos1 = 1
pos2 = 1

' loop while Msg still no emptied out
Do While (Msg) <> ""
    TextBox1.Value = Msg
    Debug.Print Len(Msg)

    pos1 = InStr(Msg, "[")
    pos2 = InStr(Msg, "]")

    ' find number of characters between "[" and "]"
    posDelta = pos2 - pos1

    Select Case posDelta
        Case Is < 0  ' only "]" found , and no "["
            Msg = Right(Msg, Len(Msg) - pos2)

        Case 3, 4 ' could be A# , or A##
            insideBrackets = Mid(Msg, pos1 + 1, pos2 - pos1 - 1)

            telphno = "" ' reset value
            telphnoPos = 0

            Msg = Right(Msg, Len(Msg) - pos2)

            ' call function with Regex to find first 10 digits in string
            telphno = GetFirstTenDigits(Msg)

            ' find position of first 10 digits inside the string
            If telphno <> "" Then telphnoPos = InStr(Msg, telphno)

            ' successfult 10-digit resulted from RegEx
            If telphnoPos > 0 Then
                ActiveCell.Value = insideBrackets
                ActiveCell.Offset(0, 1).Value = telphno

                ' remove characters from string that were extracted to the cells
                Msg = Right(Msg, Len(Msg) - (telphnoPos + 10 - 1))
                insideBrackets = "" ' reset value

                ' advance 1 row
                ActiveCell.Offset(1, 0).Select
            Else
                Msg = "" ' no 10 digits ccurrences left
            End If

        Case Is > 4
            Msg = Right(Msg, Len(Msg) - pos1)

    End Select
Loop

End Sub

***Function GetFirstTenDigits* Code** (uses the `Regex` object)

Function GetFirstTenDigits(byMixedString As String) As String

' this function uses the RegEx to find all numeric characters insde the passed string
' then it searches for the first occorunce that the number of digits = 10 ,
' and returns it to the calling Sub

    Dim RegEx As Object, Matches As Object, Match As Object

    Set RegEx = CreateObject("vbscript.regexp")
    With RegEx
        .MultiLine = False
        .Global = True
        .IgnoreCase = True
        .Pattern = "(\d+)" ' Match any set of digits
    End With

    Set Matches = RegEx.Execute(byMixedString)

    For Each Match In Matches
        If Len(Match) = 10 Then
            ' return the first match of 10 digits
            GetFirstTenDigits = Match
            Exit Function
        End If
    Next Match

End Function

Answer 2

您的问题正在发生，因为当不再有[...]对时，您不会退出循环。

如果你改变了

pos1 = InStr(pos1, Msg, "[")

在它之后紧跟以下代码，我认为你的问题会消失：

If pos1 = 0 Then
    Exit Do
End If

您的pos2计算也应该从

更改

pos2 = InStr(pos2, Msg, "]")

到

pos2 = InStr(pos1, Msg, "]")

这将确保您在当前]之后找到第一个[的位置。

在这两项更改之后，您的代码会正确处理您问题中现在提供的两个示例...除了在第二个示例中为尾随[A17]和[A21]写出记录 - 我＆＃ 39;我不确定你是否真的想要忽略它们，或者你的第二个例子是否在源数据的中途被截断。

运行时错误：5 VBA

2 个答案: