王月佳 发表于 2021-10-31 12:26:00

提取单元格内容,请大神帮助!!感激,在线等!

提取单元格内容,请大神帮助!!感激,在线等!

郑传辉 发表于 2021-11-4 23:25:54

菜鸟开火车咯:
=TRIM(MID(SUBSTITUTE(REPLACE(REPLACE(REPLACE($A3,5,0,""),FIND("20",$A3)+2,0,""),LEN(REPLACE(REPLACE($A3,5,0,""),FIND("20",$A3)+3,0,"")),0,""),"",REPT("",99)),COLUMN(D1)*200-199,200))

维修翻新各种红木家具 发表于 2021-11-7 00:49:14

#VALUE!
好像不行也,显示这个

霍霍 发表于 2021-11-17 15:04:06

ctrl+e 3行时间有点出入 不过大多数都ok

发表于 2021-11-24 13:35:37

Power Query解法

王世河 发表于 2021-11-26 18:56:19

不是针对你附件里的黄色部分的么?=TRIM(MID(SUBSTITUTE(REPLACE(REPLACE(REPLACE($A3,5,0,""),FIND("20",$A3)+2,0,""),LEN(REPLACE(REPLACE($A3,5,0,""),FIND("20",$A3)+3,0,"")),0,""),"",REPT("",99)),COLUMN(a1)*200-199,200))

捷可 发表于 2021-11-29 09:53:56

试一下下面代码,运行“提取内容”代码即可:
Public Function GFNC(ByVal s As String) As Integer
'定义在字符串中找到第一个数字字符位置的函数GFNC(GetPositionOfFirstNumericCharacter),网上有
For i = 1 To Len(s)
Dim currentCharacter As String
currentCharacter = Mid(s, i, 1)
If IsNumeric(currentCharacter) = True Then
    GFNC = i
    Exit Function
End If
Next i
End Function
Sub 提取内容()
Dim i As Integer
For i = 1 To 5
Range("c" & i) = Left(Range("a" & i), GFNC(Range("a" & i)) - 1)
Range("d" & i) = Right(Split(Range("a" & i), "202")(0), VBA.Len(Split(Range("a" & i), "202")(0)) - GFNC(Range("a" & i)) + 1)
Range("f" & i) = Right(Range("a" & i), 1)
Range("e" & i) = Split(Replace(Left(Range("a" & i), VBA.Len(Range("a" & i)) - 1), "202", "*202"), "*")(1)
Next
End Sub
说明、解释:
数据虽少,但比较复杂。
目标是取"企业名称"、"内容"、“日期"、"责任人"。
找目标规律:
"企业名称"在字符串最左,后面是数字
"内容"是第1个数字与202之间字符串
“日期"日期开头都有202字符串并为右第二位起
"责任人"都是最后1位
找到规律,逐行给B、C、D、E单元格赋值了。
完成任务,仅用函数解决不了,要写代码。
还要定义在字符串中找到第一个数字字符位置的函数GFNC(GetPositionOfFirstNumericCharacter)。
如果数据增加,修改“For i = 1 To 5”中的5即,有多少行,填写多少。
几个代码的含义:
Range("a11") = Character(Range("a1")) '第一个数字位数
Range("a8") = VBA.Len(Range("a1")) '第一行总数
Range("a10") = Left(Range("a1"), VBA.Len(Range("a1")) - 1) '取除最后一位
Range("a12") = VBA.Len(Range("a1"), "202", "*202")
Range("b14") = Replace(Range("a1"), "202", "*202") '用*将202后面数字隔开,直接取后面数字
Range("a16") = Split(Range("a1"), "202")(0) '取202前各位
'从2020或2021数字前取字符串,取“2020或2021数字前符串”减去第位数字加上1的字符串
Range("a18") = Right(Split(Range("a1"), "202")(0), VBA.Len(Split(Range("a1"), "202")(0)) - GFNC(Range("a1")) + 1)

李小满 发表于 2021-12-10 13:31:21

sorry,“Range("a11") = Character(Range("a1")) '第一个数字密码”为:
Range("a11") = GFNC(Range("a1")) '第一个数字字符位置数

小麦芽 发表于 2021-12-13 14:57:59

学习了一下正则表达式,根据需要提取的字符特点,定义4个函数,然后分别提取,比较清晰。前一个太复杂了,容易看乱:
Function shz(str As String)
'自定义提取首段汉字字符函数
With CreateObject("vbscript.RegExp")
.Global = ture
.IgnoreCase = False
.MultiLine = True
.Pattern = "^[\u4e00-\u9fa5]+" '以汉字开关的所有字符

If .test(str) Then
shz = .Execute(str)(0) '要匹配的目标(0)为匹配一次
Else
shz = "" '没有就返回空,防止出错
End If
End With

End Function
Function rq(str As String)
'自定义提取首段汉字后至日期前字符函数
With CreateObject("vbscript.RegExp")
.Global = ture
.IgnoreCase = False
.MultiLine = True
.Pattern = "{1,2}.+[\u4e00-\u9fa5]{2,3}"

If .test(str) Then
rq = .Execute(str)(0) '要匹配的目标(0)为匹配一次
Else
rq = "" '没有就返回空,防止出错
End If
End With

End Function
Function zjzf(str As String)
'自定义提取日期(带.)字符函数
With CreateObject("vbscript.RegExp")
.Global = ture
.IgnoreCase = False
.MultiLine = True
.Pattern = "{4}\.{1,2}\.{1,2}" '用d\不行

If .test(str) Then
zjzf = .Execute(str)(0) '要匹配的目标(0)为匹配一次
Else
zjzf = "" '没有就返回空,防止出错
End If
End With

End Function
Function hhz(str As String)
'自定义提取首段汉字后至日期前字符函数
With CreateObject("vbscript.RegExp")
.Global = ture
.IgnoreCase = False
.MultiLine = True
.Pattern = ".$" '所有字符的最后一位,这里与"[\u4e00-\u9fa5]$"同效

If .test(str) Then
hhz = .Execute(str)(0) '要匹配的目标(0)为匹配一次
Else
hhz = "" '没有就返回空,防止出错
End If
End With

End Function
Sub 提取4段内容()
'根据四段字符特点,定义4个函数,利用正则表达式一次性提取,比较清晰
Dim i As Integer
Range("b1:d6").ClearContents
For i = 1 To 5
Range("b" & i) = shz(Range("a" & i))
Range("c" & i) = rq(Range("a" & i))
Range("d" & i) = zjzf(Range("a" & i))
Range("e" & i) = hhz(Range("a" & i))
Next
End Sub

小澈 发表于 2021-12-22 06:10:57

附上代码:
页: [1] 2 3
查看完整版本: 提取单元格内容,请大神帮助!!感激,在线等!