【紧急求助】根据选择数据在柱状图上标注不同颜色横线（红，绿两种颜色）

lele400024

根据价格，数量两列数据生成柱状图，如下图


根据日期，最低价格，最高价格，颜色性质（绿色，红色仅两种颜色），
在上图柱状图中生成对应横线，
横线颜色根据性质，
横线长度根据最低和最高价格区间，
横线标识，根据日期。
有多条蓝色区域数据，标注多个横线，在柱状图上叠加排列即可
以下是附件举例
举例.rar (7.8 KB, 下载次数: 5)

2024-12-18 22:58 上传

点击文件名下载附件

lele400024

有没有老师，帮忙弄一下，谢谢

larer

可以做个辅助系列来显示红绿两条线

lele400024

larer 发表于 2024-12-19 19:54
可以做个辅助系列来显示红绿两条线

怎么做呢，老师

lele400024

抛砖引玉，还希望各位老师帮忙优化一下，谢谢

1. Sub 宏2()
   
2. '
   
3. ' 宏2 宏
   
4. '
   
5. 
   
6. '
   
7.     ActiveSheet.ChartObjects("图表 1").Activate
   
8.     ActiveChart.FullSeriesCollection(4).Select
   
9.     ActiveChart.FullSeriesCollection(4).Points(7).Select
   
10.     With Selection.Format.Fill
    
11.         .Visible = msoTrue
    
12.         .ForeColor.ObjectThemeColor = msoThemeColorAccent6
    
13.         .ForeColor.TintAndShade = 0
    
14.         .ForeColor.Brightness = 0.400000006
    
15.         .Transparency = 0
    
16.         .Solid
    
17.     End With
    
18.     ActiveChart.FullSeriesCollection(4).DataLabels.Select
    
19.     ActiveChart.FullSeriesCollection(4).Points(1).DataLabel.Select
    
20.     Selection.Left = 430.412
    
21.     Selection.Top = 382.419
    
22.     ActiveChart.FullSeriesCollection(4).Select
    
23.     ActiveChart.FullSeriesCollection(4).Points(1).Select
    
24.     With Selection.Format.Fill
    
25.         .Visible = msoTrue
    
26.         .ForeColor.RGB = RGB(0, 32, 96)
    
27.         .Transparency = 0
    
28.         .Solid
    
29.     End With
    
30. End Sub
    

复制代码

1. Sub 改变颜色(x, ys)
   
2. '
   
3. ' 宏2 宏
   
4. '
   
5. 
   
6. '
   
7.     ActiveSheet.ChartObjects("图表 1").Activate
   
8.     If ys = 1 Then
   
9. 
   
10.    
    
11.     ActiveChart.FullSeriesCollection(4).Points(x).Select
    
12.             With Selection.Format.Fill
    
13.             .Visible = msoTrue
    
14.             .ForeColor.RGB = RGB(192, 0, 0)
    
15.             .Transparency = 0
    
16.             .Solid
    
17.             End With
    
18.     Else
    
19.      ActiveChart.FullSeriesCollection(4).Points(x).Select
    
20.             With Selection.Format.Fill
    
21.             .Visible = msoTrue
    
22.             .ForeColor.RGB = RGB(0, 255, 0)
    
23.             .Transparency = 0
    
24.             .Solid
    
25.             End With
    
26.    
    
27.     End If
    
28.         
    
29. 
    
30. End Sub
    
31. 
    
32. Sub 改变颜色2(x, ys)
    
33. '
    
34. ' 宏2 宏
    
35. '
    
36. 
    
37. '
    
38.     ActiveSheet.ChartObjects("图表 2").Activate
    
39.     If ys = 1 Then
    
40. 
    
41.    
    
42.     ActiveChart.FullSeriesCollection(4).Points(x).Select
    
43.             With Selection.Format.Fill
    
44.             .Visible = msoTrue
    
45.             .ForeColor.RGB = RGB(192, 0, 0)
    
46.             .Transparency = 0
    
47.             .Solid
    
48.             End With
    
49.     Else
    
50.      ActiveChart.FullSeriesCollection(4).Points(x).Select
    
51.             With Selection.Format.Fill
    
52.             .Visible = msoTrue
    
53.             .ForeColor.RGB = RGB(0, 255, 0)
    
54.             .Transparency = 0
    
55.             .Solid
    
56.             End With
    
57.    
    
58.     End If
    
59.         
    
60. 
    
61. End Sub
    

复制代码

1. 
   
2. 
   
3. 
   
4. 
   
5. Private Sub Worksheet_Change(ByVal Target As Range)
   
6.     Dim KeyCells As Range
   
7.     Dim ws As Worksheet
   
8.     Dim cell As Range
   
9. 
   
10.     ' 设置工作表对象
    
11.     Set ws = Me ' 或者使用 ThisWorkbook.Sheets("Sheet1") 指定特定的工作表
    
12. 
    
13.     ' 只处理G列的变化
    
14.     On Error GoTo ExitHandler
    
15.     Application.EnableEvents = False ' 防止无限递归触发事件
    
16. 
    
17.     If Not Intersect(Target, ws.Columns("G")) Is Nothing Then
    
18.         For Each cell In Target
    
19.             ' 检查修改的单元格是否在G列
    
20.             If cell.Column = 7 Then ' G列是第7列
    
21.                 ' 检查同一行的D、E、F列是否非空
    
22.                 If Len(Trim(cell.Offset(0, -3).Value)) > 0 And _
    
23.                    Len(Trim(cell.Offset(0, -2).Value)) > 0 And _
    
24.                    Len(Trim(cell.Offset(0, -1).Value)) > 0 Then
    
25. 
    
26.                     ' 弹出提示窗口
    
27.                     'MsgBox "注意：您编辑了G列的单元格，且同行的D、E、F列非空。", vbInformation, "提醒"
    
28.                     h = Target.row - 1
    
29.                     ys = Target.Value
    
30.                     Call 改变颜色2(h, ys)
    
31.                     Target.Select
    
32.                 End If
    
33.             End If
    
34.         Next cell
    
35.     End If
    
36. 
    
37. ExitHandler:
    
38.     Application.EnableEvents = True ' 重新启用事件
    
39.     Exit Sub
    
40. 
    
41. ErrorHandler:
    
42.     MsgBox "发生错误: " & Err.Description, vbCritical
    
43.     Resume ExitHandler
    
44. End Sub
    
45. 
    
46. 
    
47. 
    

复制代码

自己能力不行，图表代码不是很熟悉，现在还想更自动化一下，提前感谢各位老师帮助

测试代码.rar (73.83 KB, 下载次数: 3)

2024-12-20 16:01 上传

点击文件名下载附件