ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 7186|回复: 9

[求助] vba编程截取指定字符串后面的内容

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-9-21 21:47 | 显示全部楼层 |阅读模式
求大神帮忙!!!!!vba编程怎么实现截取指定字符串后面的内容
也就是截取【适应症】到下一个左中括号“【”之间内容,放到下一列中。


【适应症】1.溶血性链球菌感染:咽炎、扁桃体炎、猩红热、蜂窝织炎、皮肤软组织感染、败血症可作为首选。2.草绿色链球菌或肠球菌感染:亚急性细菌性心内膜炎可首选,但需加大剂量,并与氨基甙类抗生素合用,以增强疗效。3.肺炎球菌感染:大叶性肺炎、中耳炎、鼻旁窦炎、败血症等,可首选。4.金黄色葡萄球菌感染:如疖、痈、脓肿、骨髓炎等,对本品敏感的菌株可首选。5.白喉、破伤风、气性坏疽、炭疽等,可首选,但前两者需分别合用抗毒素。6.钩端螺旋体病、梅毒、回归热及放线菌病,均可首选。【用法与用量】成人  肌注:一般感染40-80万u,Bid,严重感染 Qid。静滴:严重感染200-1000万u/日

工作簿1.rar

17.43 KB, 下载次数: 23

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-9-22 09:15 | 显示全部楼层
有没有大神帮帮忙

TA的精华主题

TA的得分主题

发表于 2018-9-22 10:48 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
用公式也简单
  1. =MID(A1,FIND("【适应症】",A1),FIND("【",A1,FIND("【适应症】",A1)+5)-FIND("【适应症】",A1)) 下拉
复制代码

TA的精华主题

TA的得分主题

发表于 2021-2-18 01:41 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2021-2-18 09:40 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
供参考。。

【适应证】.zip

23.17 KB, 下载次数: 15

TA的精华主题

TA的得分主题

发表于 2021-2-18 10:18 | 显示全部楼层
用word将强制换行符替换为“@”,再用Excel分列功能实现就可以

工作簿1.zip

15.98 KB, 下载次数: 2

头像被屏蔽

TA的精华主题

TA的得分主题

发表于 2021-2-19 10:12 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
提示: 该帖被管理员或版主屏蔽

TA的精华主题

TA的得分主题

发表于 2021-2-19 10:14 | 显示全部楼层
Wb.Worksheets(2).Cells(n, 1).Value = Mh(0).submatches(0)  这句注意修改一下 单元格下标

TA的精华主题

TA的得分主题

发表于 2021-2-19 19:48 | 显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件       ★免费下载 ★       ★ 使用帮助
我来试试手
  1. Public Sub wangway()

  2.     Dim Wb As Workbook
  3.     Dim Sht As Worksheet
  4.     Set Wb = Application.ThisWorkbook
  5.     Set Sht = Wb.Worksheets(1)
  6.     Set Regex = CreateObject("VBScript.RegExp")
  7.     OrgText = "Halo World"
  8.     With Regex
  9.         .Global = True
  10.         .Pattern = "(?:【适应症】)([^【]+?)(?:【)"
  11.     End With
  12.     n = 0
  13.     With Sht
  14.         '.Usedrange.Offset(1).clear
  15.         EndRow = .Cells(.Cells.Rows.Count, 1).End(xlUp).Row

  16.         For i = 1 To EndRow Step 1
  17.             s = .Cells(i, 1).Value
  18.             Set Mh = Regex.Execute(s)
  19.             If Mh.Count > 0 Then
  20.                 Debug.Print i, Mh(0).submatches(0)
  21.                 n = n + 1
  22.                 Wb.Worksheets(2).Cells(n, 1).Value = Mh(0).submatches(0)
  23.             End If
  24.         Next
  25.     End With
  26.                                     
  27.     Set Wb = Nothing
  28.     Set Sht = Nothing
  29.     Set Regex = Nothing
  30.     Set Mh = Nothing
  31.                                     
  32. End Sub
复制代码

TA的精华主题

TA的得分主题

发表于 2023-4-21 01:35 | 显示全部楼层
  1. Sub dd()
  2. Dim reg, match, matches
  3. Dim i, j, k, irow1 As Integer
  4. Dim str As String
  5. Set reg = CreateObject("VBScript.RegExp")
  6. With reg
  7.   .Pattern = "【适应症】.+"
  8.   .ignorecase = True
  9.   .Global = True
  10.   irow1 = Sheet1.Range("a10000").End(xlUp).Row
  11.   For i = 1 To irow1
  12.     str = Sheet1.Range("a" & i)
  13.     If .test(str) Then
  14.         Set matches = .Execute(str)
  15.         Sheet1.Range("b" & i) = matches(0)
  16.     End If
  17.   Next
  18. End With
  19. End Sub
复制代码


您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-11-16 03:01 , Processed in 0.040264 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表