根据单元格颜色对数量进行汇总

小柒S · 发表于 2024-1-17 13:56

求各位大神帮忙，根据B列的单元格颜色对A列数量进行汇总，将D列各个颜色的汇总数据结果填入E列，不能插入辅助列，感谢~~

sdytsxd991122 · 发表于 2024-1-17 14:15

3190496160 · 发表于 2024-1-17 14:21

Sub 统计()
Dim ar As Variant
Dim i As Long, r As Long
Dim br()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheet1
r = .Cells(Rows.Count, 1).End(xlUp).Row
ar = .Range("a1:b" & r)
For i = 2 To UBound(ar)
      If Trim(ar(i, 1)) <> "" Then
         ys = .Cells(i, 2).Interior.ColorIndex
         d(ys) = d(ys) + ar(i, 1)
      End If
Next i
rs = .Cells(Rows.Count, 4).End(xlUp).Row
.Range("d2:e" & rs + 1).Clear
.[d2].Resize(d.Count, 2) = Application.Transpose(Array(d.keys, d.items))
For i = 2 To d.Count + 1
      .Cells(i, 4).Interior.ColorIndex = .Cells(i, 4)
Next i
End With
MsgBox "ok!"
End Sub

3190496160 · 发表于 2024-1-17 14:22

根据颜色对数量进行汇总.rar (16.83 KB, 下载次数: 16)

松永 · 发表于 2024-1-17 14:29

看看是否能用

小柒S · 发表于 2024-1-17 14:57

sdytsxd991122 发表于 2024-1-17 14:15

哇塞大神简直太厉害啦感谢感谢

小柒S · 发表于 2024-1-17 15:01

3190496160 发表于 2024-1-17 14:22

哇塞大神好厉害崇拜崇拜~~

680926 · 发表于 2024-1-18 19:48

Sub ys()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
For i = 2 To Range("a65536").End(xlUp).Row
If Not d.exists(Range("b" & i).Interior.ColorIndex) Then
d(Range("b" & i).Interior.ColorIndex) = Range("a" & i)
Else
d(Range("b" & i).Interior.ColorIndex) = d(Range("b" & i).Interior.ColorIndex) + Range("a" & i)
End If
Next
For j = 1 To d.Count
x = d.keys
y = d.items
Range("j" & j + 1).Interior.ColorIndex = x(j - 1)
Range("k" & j + 1) = y(j - 1)
Next
End Sub

ykcbf1100 · 发表于 2024-1-19 08:53

参与一下。。。

Sub ykcbf() '//2024.1.19
Set d = CreateObject("Scripting.Dictionary")
r = Cells(Rows.Count, 1).End(3).Row
arr = Range("a1:b" & r)
For i = 2 To UBound(arr)
s = Cells(i, 2).Interior.ColorIndex
d(s) = d(s) + arr(i, 1)
Next
For i = 2 To 5
s = Cells(i, 4).Interior.ColorIndex
Cells(i, 6) = d(s)
Next
MsgBox "OK！"
End Sub

复制代码

ykcbf1100 · 发表于 2024-1-19 08:54

练个手。。。

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

[求助] 根据单元格颜色对数量进行汇总