VB查找截取遍历字符串，生成，这个该怎么写啊

「已注销」 2017-04-09 06:04:19

我写的一个小程序，按照给定条件筛选字符

有1个搜索条件字符串和5个不确定长度的字符串
搜索条件字符串我们叫做H，5个被搜索字符串依次叫做A,B,C,D,E,F
先查找A字符串里面是否有H，有的话就在H(不包含H)的位置从前逐个截取5个字符和从后逐个截取5个字符，但是还不能让这5个字符相同，比如说4812334567889，查找45，往前开始逐个截取5个字符，33218,33相同只取1个3，截取的字符往前进一步，直到5个字符都不相同，就等于是32184，往后也一样。还有如果H在A的尾端，往前或往后的字符数不足5位，那么只截取剩余几位字符，再判断重复，生成,
师傅们求教啊！！
以下是我写的代码，但是总是没法再把判断重复的插进代码里面，求指点迷津！！

Private Sub Command1_Click()

List1.Clear

List7.Clear

If Text1.Text <> "" Then

Dim Str As String, Szfg, i As Integer, Qishu As Integer, haoma As String, ge As String, shi As String, bai As String, qian As String, wan As String

Dim zuixin As String

Dim gew, shiw, baiw, qianw, wanw, shua

    Set Http = New WinHttpRequest

    Http.Option(6) = False

    Http.Option(4) = 13056

    Str = GetPage("http://chart.cp.360.cn/zst/getchartdata2?lotId=255401&chartType=x5&spanType=0&span=" & Text1.Text)

    Szfg = Split(Str, "class='tdbg_1' >1")

    For i = 0 To UBound(Szfg)

        If InStr(1, Szfg(i), "num") > 0 Then

        haoma = Mid(Szfg(i), InStr(1, Szfg(i), "num") + 5, 5)

        End If

        If Mid(Szfg(i), 1, 1) = "7" Then

        List1.AddItem "1" & Mid(Szfg(i), 1, 9) & "--" & haoma

        ge = ge & Mid(haoma, 5, 1)

        shi = shi & Mid(haoma, 4, 1)

        bai = bai & Mid(haoma, 3, 1)

        qian = qian & Mid(haoma, 2, 1)

        wan = wan & Mid(haoma, 1, 1)

        End If

    Next

    zuixin = Right(ge, 2)

    Dim AAA, u, BBB, pp, CCC, DDD, EEE, FFF, III, GGG, KKK, LL, YY, IO, OI, KOI, ij

    KKK = Array(ge, shi, bai, qian, wan)

    For u = 1 To Len(ge)

        AAA = Mid(ge, u, 2)

        CCC = Mid(shi, u, 2)

        DDD = Mid(bai, u, 2)

        EEE = Mid(qian, u, 2)

        FFF = Mid(wan, u, 2)

        GGG = Array(AAA, CCC, DDD, EEE, FFF)

        For III = 0 To UBound(GGG)

            If GGG(III) = zuixin Then

               YY = Mid(KKK(III), u - 2, 1)

               For LL = u - 2 To u - 7

                   BBB = BBB & Mid(KKK(III), LL, 1)

               Next

               BBB = ""

               For pp = u + 2 To u + 7

                   BBB = BBB & Mid(KKK(III), pp, 1)

               Next

               List7.AddItem BBB

               BBB = ""

            End If

        Next

    Next

End If

End Sub

...全文

1476 10 打赏收藏转发到动态举报

写回复

用AI写文章

10 条回复

切换为时间正序

请发表友善的回复…

发表回复

「已注销」 2017-04-13

打赏
举报

引用 9 楼 Chen8013 的回复:

1.　自己不把问题说清楚！你有说过“要在同一字符串中找多处符合的”吗！ 2.　能找1处的、并处理，稍加修改就可以实现“找多处”的，这有多大难度。

舉杯邀明月 2017-04-11

打赏
举报

1.　自己不把问题说清楚！你有说过“要在同一字符串中找多处符合的”吗！ 2.　能找1处的、并处理，稍加修改就可以实现“找多处”的，这有多大难度。

「已注销」 2017-04-11

打赏
举报

会了，这次透彻了

「已注销」 2017-04-11

打赏
举报

引用 2 楼 Chen8013 的回复:

没看懂你的代码中“第29行到第50行”这段For循环的作用。

不过，按你说的“截取字符串”的方法，我给你一段代码如下：

Private Sub Command2_Click()
   Dim strSpec As String
   Dim strText As String
   Dim strChar As String
   Dim sA$, sE As String
   Dim i&, k&, w  As Long

   strText = "4812334567889"
   strSpec = "45"
   k = InStr(1&, strText, strSpec)
   sA = "": w = 0&
   For i = k - 1& To 1& Step -1&
      strChar = Mid$(strText, i, 1&)
      If (0& = InStr(1&, sA, strChar)) Then
         sA = sA & strChar
         w = 1& + w
         If (5& = w) Then Exit For
      End If
   Next
   sE = "": w = 0&
   For i = 2& + k To Len(strText)
      strChar = Mid$(strText, i, 1&)
      If (0& = InStr(1&, sE, strChar)) Then
         sE = sE & strChar
         w = 1& + w
         If (5& = w) Then Exit For
      End If
   Next
   MsgBox "向前截取的字符串：" & sA & vbLf & _
            "向后截取的字符串：" & sE, 64&, "截取结果"
End Sub
' 向前截取的字符串：32184
' 向后截取的字符串：6789

引用 2 楼 Chen8013 的回复:

没看懂你的代码中“第29行到第50行”这段For循环的作用。

不过，按你说的“截取字符串”的方法，我给你一段代码如下：

Private Sub Command2_Click()
   Dim strSpec As String
   Dim strText As String
   Dim strChar As String
   Dim sA$, sE As String
   Dim i&, k&, w  As Long

   strText = "4812334567889"
   strSpec = "45"
   k = InStr(1&, strText, strSpec)
   sA = "": w = 0&
   For i = k - 1& To 1& Step -1&
      strChar = Mid$(strText, i, 1&)
      If (0& = InStr(1&, sA, strChar)) Then
         sA = sA & strChar
         w = 1& + w
         If (5& = w) Then Exit For
      End If
   Next
   sE = "": w = 0&
   For i = 2& + k To Len(strText)
      strChar = Mid$(strText, i, 1&)
      If (0& = InStr(1&, sE, strChar)) Then
         sE = sE & strChar
         w = 1& + w
         If (5& = w) Then Exit For
      End If
   Next
   MsgBox "向前截取的字符串：" & sA & vbLf & _
            "向后截取的字符串：" & sE, 64&, "截取结果"
End Sub
' 向前截取的字符串：32184
' 向后截取的字符串：6789

老师，你只查找的字符串的第一个符合条件的前后5位，，要查找整个字符串，找到不跳出，然后再查找到最后一位

「已注销」 2017-04-11

打赏
举报

引用 2 楼 Chen8013 的回复:

没看懂你的代码中“第29行到第50行”这段For循环的作用。

不过，按你说的“截取字符串”的方法，我给你一段代码如下：

Private Sub Command2_Click()
   Dim strSpec As String
   Dim strText As String
   Dim strChar As String
   Dim sA$, sE As String
   Dim i&, k&, w  As Long

   strText = "4812334567889"
   strSpec = "45"
   k = InStr(1&, strText, strSpec)
   sA = "": w = 0&
   For i = k - 1& To 1& Step -1&
      strChar = Mid$(strText, i, 1&)
      If (0& = InStr(1&, sA, strChar)) Then
         sA = sA & strChar
         w = 1& + w
         If (5& = w) Then Exit For
      End If
   Next
   sE = "": w = 0&
   For i = 2& + k To Len(strText)
      strChar = Mid$(strText, i, 1&)
      If (0& = InStr(1&, sE, strChar)) Then
         sE = sE & strChar
         w = 1& + w
         If (5& = w) Then Exit For
      End If
   Next
   MsgBox "向前截取的字符串：" & sA & vbLf & _
            "向后截取的字符串：" & sE, 64&, "截取结果"
End Sub
' 向前截取的字符串：32184
' 向后截取的字符串：6789

代码是查找个十百千万这5个字符串，俩位一字符往下移动查找是否有特定字符，用InStr更简单，但是还要去重复，晕了。。

of123 2017-04-10

打赏
举报

这个不难啊。


Dim H As String, A As String
Dim strHeader As String, strTailer As String, strTemp As String
Dim p As Integer, i As Integer

H = "45"
A = "4812334567889"
p = InStr(A, H)
If p Then
    strHeader = ""
    strTemp = Left(A, p - 1)
    For i = Len(strTemp) To 1 Step -1
        If InStr(strHeader, Mid(strTemp, i, 1)) = 0 Then strHeader = strHeader & Mid(strTemp, i, 1)
        If Len(strHeader) = 5 Then Exit For
    Next i
    Debug.Print strHeader

    strTailer = ""
    strTemp = Mid(A, p + Len(H))
    For i = 1 To Len(strTemp)
        If InStr(strTailer, Mid(strTemp, i, 1)) = 0 Then strTailer = strTailer & Mid(strTemp, i, 1)
        If Len(strTailer) = 5 Then Exit For
    Next i
    Debug.Print strTailer
End If

赵4老师 2017-04-10

打赏
举报

仅供参考：

Function RegExpN(ptn, txt, n) As String
'Debug.Print "[" + RegExpN("[012]{8}", "mno_if22220101_and11000011_or00111100_xor10101010.txt", 1) + "]"
'[22220101]
'Debug.Print "[" + RegExpN("[012]{8}", "mno_if22220101_and11000011_or00111100_xor10101010.txt", 2) + "]"
'[11000011]
'Debug.Print "[" + RegExpN("[012]{8}", "mno_if22220101_and11000011_or00111100_xor10101010.txt", 3) + "]"
'[00111100]
'Debug.Print "[" + RegExpN("[012]{8}", "mno_if22220101_and11000011_or00111100_xor10101010.txt", 4) + "]"
'[10101010]
'Debug.Print "[" + RegExpN("[012]{8}", "mno_if22220101_and11000011_or00111100_xor10101010.txt", 5) + "]"
'[]
'Debug.Print "[" + RegExpN("[a-z]+(\d+)[_.]", "mno_if22220101_and11000011_or00111100_xor10101010.txt", 4) + "]"
'[xor10101010.]
'Debug.Print "[" + RegExpN("[a-z]+(\d+)[_.]", "mno_if22220101_and11000011_or00111100_xor10101010.txt", 4.1) + "]"
'[10101010]
'Debug.Print "[" + RegExpN("<abc>(.*)</abc>", "<html><ab>AB</ab><abc>ABC汉字</abc></html>", 1) + "]"
'[<abc>ABC汉字</abc>]
'Debug.Print "[" + RegExpN("<abc>(.*)</abc>", "<html><ab>AB</ab><abc>ABC汉字</abc></html>", 1.1) + "]"
'[ABC汉字]
Dim rtnstr As String
Dim codestr As String
    rtnstr = ""
    With ScriptControl1
        ' Set script language (VBScript is the default).
        .Language = "VBScript"
        ' Set UI interaction (TRUE is the default).
        .AllowUI = True
        ' Copy the script to the control.
'--------------------------------------------------------
codestr = ""
codestr = codestr + "Function RegExpTest(patrn, strng, ns)      " + vbCrLf
codestr = codestr + "    Dim regEx, Match, Matches, RetStr, ii  " + vbCrLf
codestr = codestr + "    Dim nn,ss                              " + vbCrLf
codestr = codestr + "    nn=fix(ns)                             " + vbCrLf
codestr = codestr + "    if nn=ns then                          " + vbCrLf
codestr = codestr + "        ss=-1                              " + vbCrLf
codestr = codestr + "    else                                   " + vbCrLf
codestr = codestr + "        ss=(ns-nn)*10-1                    " + vbCrLf
codestr = codestr + "    end if                                 " + vbCrLf
codestr = codestr + "    Set regEx = New RegExp                 " + vbCrLf
codestr = codestr + "    regEx.Pattern    = patrn               " + vbCrLf
codestr = codestr + "    regEx.IgnoreCase = True                " + vbCrLf
codestr = codestr + "    regEx.Global     = True                " + vbCrLf
codestr = codestr + "    Set Matches = regEx.Execute(strng)     " + vbCrLf
codestr = codestr + "    ii=0                                   " + vbCrLf
codestr = codestr + "    For Each Match in Matches              " + vbCrLf
codestr = codestr + "        ii=ii+1                            " + vbCrLf
codestr = codestr + "        if ii=nn then                      " + vbCrLf
codestr = codestr + "            if ss=-1 then                  " + vbCrLf
codestr = codestr + "                RetStr=Match.Value         " + vbCrLf
codestr = codestr + "            else                           " + vbCrLf
codestr = codestr + "                RetStr=Match.SubMatches(ss)" + vbCrLf
codestr = codestr + "            end if                         " + vbCrLf
codestr = codestr + "            exit for                       " + vbCrLf
codestr = codestr + "        end if                             " + vbCrLf
codestr = codestr + "    Next                                   " + vbCrLf
codestr = codestr + "    RegExpTest = RetStr                    " + vbCrLf
codestr = codestr + "    Set regEx = Nothing                    " + vbCrLf
codestr = codestr + "End Function                               " + vbCrLf
'--------------------------------------------------------
        .AddCode codestr
        Dim oMod As Object
        Set oMod = .Modules(GlobalModule)
        rtnstr = oMod.Run("RegExpTest", ptn, txt, n)
        Set oMod = Nothing
    End With
    RegExpN = rtnstr
End Function

舉杯邀明月 2017-04-09

打赏
举报

你的代码中“第29行到第50行”这段For循环，是有Bug的，有时会出现“无效的过程调用或参数”错误。

舉杯邀明月 2017-04-09

打赏
举报

没看懂你的代码中“第29行到第50行”这段For循环的作用。

不过，按你说的“截取字符串”的方法，我给你一段代码如下：

Private Sub Command2_Click()
   Dim strSpec As String
   Dim strText As String
   Dim strChar As String
   Dim sA$, sE As String
   Dim i&, k&, w  As Long

   strText = "4812334567889"
   strSpec = "45"
   k = InStr(1&, strText, strSpec)
   sA = "": w = 0&
   For i = k - 1& To 1& Step -1&
      strChar = Mid$(strText, i, 1&)
      If (0& = InStr(1&, sA, strChar)) Then
         sA = sA & strChar
         w = 1& + w
         If (5& = w) Then Exit For
      End If
   Next
   sE = "": w = 0&
   For i = 2& + k To Len(strText)
      strChar = Mid$(strText, i, 1&)
      If (0& = InStr(1&, sE, strChar)) Then
         sE = sE & strChar
         w = 1& + w
         If (5& = w) Then Exit For
      End If
   Next
   MsgBox "向前截取的字符串：" & sA & vbLf & _
            "向后截取的字符串：" & sE, 64&, "截取结果"
End Sub
' 向前截取的字符串：32184
' 向后截取的字符串：6789