ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

   
高效办公必会的Office实战技巧 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel函数公式学习大典 Office 365免费试用,报名现在开始! 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 打造核心竞争力的职场宝典 13门Excel免费公开课任你学
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 183|回复: 10

按条件截取一段文字中的数据

[复制链接]

TA的精华主题

TA的得分主题

发表于 2018-7-10 16:41 | 显示全部楼层 |阅读模式
说明都在附件里。大神求助。

按指定条件读取一段话的文字.zip

7.06 KB, 下载次数: 22

TA的精华主题

TA的得分主题

发表于 2018-7-10 16:58 | 显示全部楼层
颜色的公式 数组 下拉
  1. =TEXTJOIN("、",1,IFERROR(IF(MATCH(LEFT(TRIM(MID(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A3,"岩性:",),"。",),"、",REPT(" ",99)),ROW($1:$20)*99-98,104)),FIND("色",TRIM(MID(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A3,"岩性:",),"。",),"、",REPT(" ",99)),ROW($1:$20)*99-98,104)))),LEFT(TRIM(MID(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A3,"岩性:",),"。",),"、",REPT(" ",99)),ROW($1:$20)*99-98,104)),FIND("色",TRIM(MID(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A3,"岩性:",),"。",),"、",REPT(" ",99)),ROW($1:$20)*99-98,104)))),)=ROW($1:$20),LEFT(TRIM(MID(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A3,"岩性:",),"。",),"、",REPT(" ",99)),ROW($1:$20)*99-98,104)),FIND("色",TRIM(MID(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A3,"岩性:",),"。",),"、",REPT(" ",99)),ROW($1:$20)*99-98,104)))),""),""))
复制代码

TA的精华主题

TA的得分主题

发表于 2018-7-10 17:07 | 显示全部楼层
岩性处公式 数组 下拉
  1. =TEXTJOIN("、",1,IFERROR(IF(MATCH(MID(TRIM(MID(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A3,"岩性:",),"。",),"、",REPT(" ",99)),ROW($1:$20)*99-98,104)),FIND("色",TRIM(MID(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A3,"岩性:",),"。",),"、",REPT(" ",99)),ROW($1:$20)*99-98,104)))+1,9),MID(TRIM(MID(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A3,"岩性:",),"。",),"、",REPT(" ",99)),ROW($1:$20)*99-98,104)),FIND("色",TRIM(MID(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A3,"岩性:",),"。",),"、",REPT(" ",99)),ROW($1:$20)*99-98,104)))+1,9),)=ROW($1:$20),MID(TRIM(MID(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A3,"岩性:",),"。",),"、",REPT(" ",99)),ROW($1:$20)*99-98,104)),FIND("色",TRIM(MID(SUBSTITUTE(SUBSTITUTE(SUBSTITUTE(A3,"岩性:",),"。",),"、",REPT(" ",99)),ROW($1:$20)*99-98,104)))+1,9),""),""))
复制代码

TA的精华主题

TA的得分主题

 楼主| 发表于 2018-7-10 17:32 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2018-7-10 17:40 | 显示全部楼层
你的版本不支持TEXTJOIN 这个函数 这个要微软365版本或者WPS 2016最新版的才有 这种连接内存数组 是这个函数的特长 我非常喜欢用

TA的精华主题

TA的得分主题

发表于 2018-7-10 18:06 | 显示全部楼层
Sub test5()
Dim arr, brr, crr, drr(1 To 9, 1 To 2)
Set exp1 = CreateObject("vbscript.regexp")
Set exp2 = CreateObject("vbscript.regexp")
Set dic = CreateObject("scripting.dictionary")
Set dic2 = CreateObject("scripting.dictionary")
arr = Range("A3:A11")
    With exp1
        .Global = True
        .Pattern = "[\u4e00-\u9fa5]+色"
    End With
    With exp2
        .Global = True
        .Pattern = "色[\u4e00-\u9fa5]+岩"
    End With
    For i = 1 To UBound(arr)

   
        Set ks = exp1.Execute(arr(i, 1))
   
   
        For Each k In ks
            dic(k.Value) = 0
        Next
        brr = dic.keys
        colo = Join(brr, "、")
   
   
   
        Set ks2 = exp2.Execute(arr(i, 1))
   
        
        For Each k2 In ks2
            dic2(Replace(k2.Value, "色", "")) = 0
        Next
        crr = dic2.keys
        rock = Join(crr, "、")
   
        m = m + 1

        drr(m, 1) = colo
        drr(m, 2) = rock
        brr = ""
        crr = ""
        colo = ""
        rock = ""
        ks = ""
        ks2 = ""
        dic.RemoveAll
        dic2.RemoveAll
        
        
    Next

Range("C3:D11").ClearContents

Range("C3").Resize(9, 2) = drr

        
            
End Sub

TA的精华主题

TA的得分主题

发表于 2018-7-10 18:07 | 显示全部楼层
本帖最后由 mikezhan 于 2018-7-10 18:09 编辑

这种问题,放弃函数!!!!!!!!

直接 VBA ,字典+正则+数组 解决!!!!!!!!!

按指定条件读取一段话的文字.rar

14.48 KB, 下载次数: 5

TA的精华主题

TA的得分主题

发表于 2018-7-10 18:10 | 显示全部楼层
重要的事情说三遍: 凡是这种复杂的问题,不要用函数,不要用函数,不要用函数!!!!

TA的精华主题

TA的得分主题

发表于 2018-7-10 18:27 | 显示全部楼层
mikezhan 发表于 2018-7-10 18:10
重要的事情说三遍: 凡是这种复杂的问题,不要用函数,不要用函数,不要用函数!!!!

所言极是!!!!!

TA的精华主题

TA的得分主题

发表于 2018-7-10 19:22 | 显示全部楼层
本帖最后由 准提部林 于 2018-7-10 19:24 编辑

Function GetTxt(STR$, U%)
Dim T, TT$(1 To 3)
STR = Replace(Replace(Replace(STR, "岩性:", ""), "。", ""), "色", "色、")
For Each T In Split(STR, "、")
  If InStr("/" & TT(3) & "/", "/" & T & "/") Then GoTo 101 Else TT(3) = TT(3) & "/" & T
  If Right(T, 1) = "色" Then TT(1) = TT(1) & "、" & T
  If Right(T, 1) = "岩" Then TT(2) = TT(2) & "、" & T
101: Next
GetTxt = Mid(TT(U), 2)
End Function
 
D3公式:=GetTxt($A3,COLUMN(A$1)) 右拉.下拉
 
 

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

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,高效办公专列,每天发车

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

GMT+8, 2018-8-18 12:34 , Processed in 0.070478 second(s), 11 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 2001-2017 Wooffice Inc.

   

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

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

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