A列同时存在科1科2科3，提取信息到B列

yshcy · 发表于 2024-4-27 12:07

但是科1科2科3的顺序，各单元格不一定是一样的。请教VBA代码，谢谢。

剑指E · 发表于 2024-4-27 13:29

本帖最后由剑指E 于 2024-4-27 15:21 编辑

函数：

=IF(COUNT(FIND("科"&{1,2,3},A2))=3,MID(A2,FIND("-",A2)+1,FIND("-",A2,FIND("-",A2)+1)-FIND("-",A2)-1)&"："&MID(A2,AGGREGATE(14,6,FIND("-",A2,ROW(1:99)),1)+1,99),"")

复制代码

cnmlgb9998 · 发表于 2024-4-27 13:40

=DROP(REDUCE("",A2:A11,LAMBDA(x,y,VSTACK(x,IF(COUNT(FIND({"科1","科2","科3"},y))=3,LET(_a,TEXTSPLIT(y,,"-",TRUE),TEXTJOIN(":",TRUE,VSTACK(CHOOSEROWS(_a,2),TAKE(_a,-1)))),"")))),1)

复制代码

yshcy · 发表于 2024-4-27 13:51

cnmlgb9998 发表于 2024-4-27 13:40

谢谢。函数用得这么顺手。

cnmlgb9998 · 发表于 2024-4-27 13:55

yshcy 发表于 2024-4-27 13:51
谢谢。函数用得这么顺手。

现在有 365 新函数，比老函数好用多了。

swl4561255 · 发表于 2024-4-27 14:06

Sub test()
arr = Range("A1").CurrentRegion
Dim brr(1 To 100, 1 To 1)
For i = 2 To UBound(arr)
If arr(i, 1) Like "*科1*" And arr(i, 1) Like "*科2*" And arr(i, 1) Like "*科3*" Then
br = Split(arr(i, 1), "-")
brr(i - 1, 1) = br(1) & ":" & br(UBound(br))
End If
Next
[B2].Resize(UBound(brr), 1) = brr
End Sub

复制代码

yshcy · 发表于 2024-4-27 17:03

swl4561255 发表于 2024-4-27 14:06

谢谢你的热心回复。学习了

micch · 发表于 2024-4-27 18:08

=SUBSTITUTE(REDUCE(TEXTAFTER(A2,"-"),"-科"&ROW($1:$3),LAMBDA(x,y,IF(ISERR(FIND(y,x)),"",SUBSTITUTE(x,y,)))),"-",":")

复制代码

micch · 发表于 2024-4-27 18:15

Sub Main()
i = 2
Do While Cells(i, 1).Value <> ""
x = Cells(i, 1).Value
x = Mid(x, InStr(x, "-") + 1)
x = Replace(x, "-", ":")
For j = 1 To 3
If InStr(x, ":科" & j & ":") Then x = Replace(x, ":科" & j & ":", ":") Else x = ""
Next
Cells(i, 2).Value = x
i = i + 1
Loop
End Sub

复制代码

ykcbf1100 · 发表于 2024-4-27 19:53

附件供参考。。。

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