鼠标点击单元格自动生成对应图表

游戏一场 · 发表于 2019-4-11 13:55

例如我点击商品那一列的A，红色区域会显示该商品4个月销量的折线图，点击B会生成B销量的折线图，这种能实现吗？？

saigyouryu · 发表于 2019-4-11 14:56

简单写了个你试试看行不，代码放到sheet里，判断条件和坐标位置你可以自己修改下
Private Sub worksheet_selectionchange(ByVal rng As Range)
If rng.Row <= 5 And rng.Column = 1 Then
      For Each sit In Sheets(1).Shapes
         sit.Delete
      Next
      Sheets(1).Shapes.AddChart2(201, xlColumnClustered, 400, 40).Select
      ActiveChart.SetSourceData Source:=Range("s1!$B$" & rng.Row & ":$E$" & rng.Row)
End If
End Sub

游戏一场 · 发表于 2019-4-11 15:55

saigyouryu 发表于 2019-4-11 14:56
简单写了个你试试看行不，代码放到sheet里，判断条件和坐标位置你可以自己修改下
Private Sub worksheet_ ...

尴尬。对vba代码一窍不通。而且为什么的出来的结果是全部都在一个图表呢。能不能我点击A就显示A的。

悠悠的炊烟 · 发表于 2019-4-11 16:55

附件。。。。。。。。。。。

游戏一场 · 发表于 2019-4-11 17:22

悠悠的炊烟发表于 2019-4-11 16:55
附件。。。。。。。。。。。

感谢·~~~~~~~

dengxingchang · 发表于 2019-4-12 00:27

学习学习V神的技术和思路

haydeng · 发表于 2019-4-13 09:36

前段时间刚好在“老徐的Excel”中学习到，可以参考。

micch · 发表于 2019-4-13 11:42

只会简单的动态图，模拟一个练习，先模拟一份数据

将鼠标点击选择的行号存入N2单元格，用代码工作表事件实现；然后将图表的数据源定义名称，系列名称存入O2

Datous · 发表于 2019-4-13 11:53

凑凑热闹。

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngData As Range, rngIntersection As Range
Set rngData = [a2].CurrentRegion.Offset(1, 1)
Set rngData = rngData.Resize(rngData.Rows.Count - 1, rngData.Columns.Count - 1)
Set rngIntersection = Excel.Intersect(rngData, Target)
If (Not rngIntersection Is Nothing) Then
Shapes(1).Visible = True
Shapes(1).Chart.SeriesCollection(1).Values = Excel.Intersect(Target.EntireRow, rngData)
Else
Shapes(1).Visible = False
End If
End Sub

复制代码

Datous · 发表于 2019-4-13 11:54

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim rngData As Range, rngIntersection As Range
Set rngData = [a2].CurrentRegion.Offset(1, 1)
Set rngData = rngData.Resize(rngData.Rows.Count - 1, rngData.Columns.Count - 1)
Set rngIntersection = Excel.Intersect(rngData, Target)
If (Not rngIntersection Is Nothing) Then
Shapes(1).Visible = True
Shapes(1).Chart.SeriesCollection(1).Values = Excel.Intersect(Target.EntireRow, rngData)
Else
Shapes(1).Visible = False
End If
End Sub

复制代码

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

[求助] 鼠标点击单元格自动生成对应图表

评分