行瘦身，请问我错在哪儿了，谢谢yynrzwh老师！

lhj323323

老师：

上传的附件里有写好的语句
共有3种写法
只有第1种，能正确提取，但就是写得有点笨。
而第2、3种，照本宣科，却等于没有瘦身。

老师如有空，请帮忙看看，我错在哪儿
多谢多谢
求助.rar (40.47 KB, 下载次数: 8)

2024-1-13 11:19 上传

点击文件名下载附件

shiruiqiang

================

gwjkkkkk

Option Explicit
Sub TEST1()
    Dim ar, i&, j&, r&
   
    Application.ScreenUpdating = False
    ar = [A1].CurrentRegion.Value
    ar(1, 1) = "标题2": ar(1, 2) = "标题4"
    r = 1
    With CreateObject("VBScript.RegExp")
        .Pattern = "\(8|\(9|\(43|\(68|\(1|ST|N|C|Ｂ"
        For i = 2 To UBound(ar)
            If .TEST(ar(i, 2)) Then
                r = r + 1
                For j = 1 To 2
                    ar(r, j) = ar(r, j * 2)
                Next j
            End If
        Next i
    End With
   
    Columns("M:N").ClearContents
    [M1].Resize(r, 2) = ar
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考。。。

yynrzwh

1.      st = "(8|(9|(43|(68|(1|ST|*ST|N|C|Ｂ"
   
2. Dim sp, kg&, x&
   
3. For i = 1 To UBound(arr)
   
4.     S = arr(i, 2)
   
5.     sp = Split(st, "|")
   
6.     kg = 0
   
7.     For x = 0 To UBound(sp)
   
8.         If InStr(S, sp(x)) > 0 Then kg = kg + 1
   
9.     Next x
   
10.    
    
11.     If kg = 0 Then
    
12.         j = j + 1
    
13.         ar(j, 1) = arr(i, 2)
    
14.         ar(j, 2) = arr(i, 4)
    
15.     End If
    
16. Next

复制代码

lhj323323

gwjkkkkk 发表于 2024-1-13 19:52
请参考。。。

谢谢老师！

以下红框内的内容，是不该提取出来的。

lhj323323

yynrzwh 发表于 2024-1-13 20:32

谢谢老师！
测试成功了！

gwjkkkkk

lhj323323 发表于 2024-1-14 03:14
谢谢老师！

以下红框内的内容，是不该提取出来的。

理解错了。。。

lhj323323

gwjkkkkk 发表于 2024-1-14 09:21
理解错了。。。

不是老师的错，是我的语文水平差不些
再次谢谢老师！

lhj323323

gwjkkkkk 发表于 2024-1-14 09:21
理解错了。。。

我现在才发现我错在哪儿了
一楼提供的源码里，需要纳入【被包含】的关键词是
某列的全部内容
st = "次新股|含B股|粤港澳|综合类|雄安新区"
而本次求助的却是某列的部分内容
st = "(8|(9|(43|(68|(1|ST|*ST|N|C|Ｂ"

所以，之前的求助而得的源码，还不能完全照搬。