分类求和

转角处的沉思 · 发表于 2024-12-20 08:50

本帖最后由转角处的沉思于 2024-12-21 14:08 编辑

请教如何实现截图描述的这种模式的分类求和，谢谢。

liulang0808 · 发表于 2024-12-20 09:03

liulang0808 · 发表于 2024-12-20 09:03

供参考。。。。。。。。。

ykcbf1100 · 发表于 2024-12-20 09:10

本帖最后由 ykcbf1100 于 2024-12-20 09:18 编辑

附件供参考。。。

ykcbf1100 · 发表于 2024-12-20 09:11

本帖最后由 ykcbf1100 于 2024-12-20 09:17 编辑

参与一下。。。

Sub ykcbf() '//2024.12.20
Application.ScreenUpdating = False
Set d = CreateObject("Scripting.Dictionary")
r = Cells(Rows.Count, 1).End(3).Row
arr = [a1].Resize(r, 6).Value
On Error Resume Next
For i = 2 To UBound(arr)
st = Split(arr(i, 6), "+")
stt = Split(arr(i, 1), "-")
For x = 0 To UBound(st)
s = st(x)
If Not d.exists(s) Then
d(s) = Array(stt(0), 1, arr(i, 4))
Else
t = d(s)
If InStr(t(0), stt(0)) = 0 Then t(0) = t(0) & "|" & stt(0)
t(1) = t(1) + 1
t(2) = t(2) + arr(i, 4)
d(s) = t
End If
Next
Next
ReDim brr(1 To d.Count, 1 To 4)
For Each k In d.keys
m = m + 1
brr(m, 1) = k
t = d(k)
k = Split(t(0), "|")
brr(m, 2) = UBound(k) + 1
brr(m, 3) = t(1)
brr(m, 4) = t(2)
Next
[m2].Resize(1000, 4) = ""
[m2].Resize(m, 4) = brr
Set d = Nothing
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub

复制代码

loirol · 发表于 2024-12-20 09:13

函数法
M2
=UNIQUE(TEXTSPLIT(TEXTJOIN("+",,F2:F6),,"+"))

N2
=COUNTA(FILTER(UNIQUE(IFERROR(IF(FIND(M2,$F$2:$F$6),TEXTBEFORE($A$2:$A$6,"-")),"")),UNIQUE(IFERROR(IF(FIND(M2,$F$2:$F$6),TEXTBEFORE($A$2:$A$6,"-")),""))<>""))

O2
=SUMPRODUCT(--(TEXTSPLIT(TEXTJOIN("+",,$F$2:$F$6),"+")=M2))

P2
=SUM(IFERROR(IF(FIND(M2,$F$2:$F$6),$D$2:$D$6),0))

飞天篮球猪 · 发表于 2024-12-20 10:04

插件解法...仅供参考...

转角处的沉思 · 发表于 2024-12-20 10:14

liulang0808 发表于 2024-12-20 09:03
供参考。。。。。。。。。

感谢刘版帮助，完美运行。

转角处的沉思 · 发表于 2024-12-20 10:15

ykcbf1100 发表于 2024-12-20 09:10
附件供参考。。。

感谢草爷帮助，完美运行。

转角处的沉思 · 发表于 2024-12-20 10:15

loirol 发表于 2024-12-20 09:13
函数法
M2
=UNIQUE(TEXTSPLIT(TEXTJOIN("+",,F2:F6),,"+"))

感谢帮助，函数也很好，效果不错。

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

[已解决] 分类求和

评分

评分

评分

评分

评分