气泡图能否按类别动态调整颜色？

gzdoll81

气泡图能否按根据设定的颜色，动态调整颜色？请大家指导一下，如附件中所示。

493861364

写代码应该可以

493861364

仅供参考，网上复制粘贴的，那位老师有更简洁的代码请赐教
Sub aa()
    ActiveSheet.ChartObjects("图表 1").Activate

    n = ActiveChart.FullSeriesCollection(1).Points.Count
    For i = 1 To n
        addr = Cells(2 + i, 6).Address
        r = Split(get_RGB(addr), ",")(0)
        g = Split(get_RGB(addr), ",")(1)
        b = Split(get_RGB(addr), ",")(2)
        ActiveChart.FullSeriesCollection(1).Points(i).Format.Fill.ForeColor.RGB = RGB(r, g, b)
    Next

End Sub
Function get_RGB(addr) As String
'  addr = ActiveWorkbook.Application.ThisCell.Address
  c = Range(addr).Interior.Color
  r = c Mod 256
  g = (c - r) / 256 Mod 256
  b = (c - r - g * 256) / 256 ^ 2
  get_RGB = r & "," & g & "," & b
End Function

gzdoll81

493861364 发表于 2023-2-8 13:18
仅供参考，网上复制粘贴的，那位老师有更简洁的代码请赐教
Sub aa()
    ActiveSheet.ChartObjects("图表 ...

能不能在我附件中的excel帮忙填写一下，代码我不太会。

493861364

gzdoll81 发表于 2023-2-8 19:51
能不能在我附件中的excel帮忙填写一下，代码我不太会。

那就4个颜色，每一个颜色做一个数据系列
要实现根据单元格颜色动态改变气泡颜色，可以使用宏表函数提取单元格的颜色值，作为判断的依据

wangg913

1. Sub 按钮1_Click()
   
2.     With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1)
   
3.         For i = 1 To .Points.Count
   
4.             .Points(i).Format.Fill.ForeColor.RGB = Range("F2").Offset(i).Interior.Color
   
5.         Next
   
6.     End With
   
7. End Sub

复制代码

493861364

wangg913 发表于 2023-2-11 00:05

版主威武！！学习到了！

imhereing

收藏學習了,感謝分享

曹红星

wangg913 发表于 2023-2-11 00:05

厉害啊！！这个图

zenglan2007BB

wangg913 发表于 2023-2-11 00:05

学习了，谢谢！