怎么用VBA提取下列红色指定的数据

wwhhwg · 发表于 2018-7-9 21:40

[)>@06@12S0002@12VS0175@KPO170919008@PPCB-05006-00-03@1T170922027@6D20180628@Q8PCS@@
以上数据是用扫描枪扫描出来的。。

一把小刀闯天下 · 发表于 2018-7-9 22:36

'0002 为什么不获取？

Option Explicit

Sub test()
  Dim t, mark, arr(), i, j, k, n
  mark = "0123456789"
  t = "[)>@06@12S0002@12VS0175@KPO170919008@PPCB-05006-00-03@1T170922027@6D20180628@Q8PCS@@"
  t = Split(t, "@")
  For i = 1 To UBound(t)
If Len(t(i)) > 0 Then
   For j = 1 To Len(t(i))
      If InStr(mark, Mid(t(i), j, 1)) = 0 Then
      n = n + 1
      ReDim Preserve arr(1 To n)
      arr(n) = Mid(t(i), j + 1, Len(t(i)) - j)
      Exit For
      End If
   Next
End If
  Next
  If n > 0 Then MsgBox Join(arr, vbNewLine)
End Sub

duquancai · 发表于 2018-7-9 22:44

没看出有何规律？？？

tudarong · 发表于 2018-7-9 22:51

应该不止提取所列出来的这几个字符串吧？

duquancai · 发表于 2018-7-9 23:05

本帖最后由 duquancai 于 2018-7-9 23:29 编辑

Sub main()
msgbox "详见楼下代码！"
End Sub

复制代码

duquancai · 发表于 2018-7-9 23:16

Sub main()
Dim js As Object, s$
Set js = CreateObject("MSScriptControl.ScriptControl")
js.Language = "JavaScript"
s = "[)>@06@12S0002@12VS0175@KPO170919008@PPCB-05006-00-03@1T170922027@6D20180628@Q8PCS@@"
MsgBox js.eval("a=[],r=/[A-RT-Z]([^@]+)/g;while(m=r.exec('" & s & "'))a.push(m[1]);a.join('\n')")
End Sub

复制代码

ggmmlol · 发表于 2018-7-10 17:54

提取红色字符.rar (18.85 KB, 下载次数: 13)

wwhhwg · 发表于 2018-7-13 18:54

我是想把每一组红色的放在一列，做数据筛选、汇总

wwhhwg · 发表于 2018-7-13 19:11

想要实现这样的功能，

ggmmlol · 发表于 2018-7-14 18:28

wwhhwg 发表于 2018-7-13 19:11
想要实现这样的功能，

你想要拆分到列的结果，可以用我在7楼附件中的公式2先取得未拆分前的效果，然后复制粘贴为值之后，按空格分列就OK了

		自动登录	找回密码
密码			免费注册

[求助] 怎么用VBA提取下列红色指定的数据