返回列表 上一主題 發帖

[發問] 類似移動指引線的效果

[發問] 類似移動指引線的效果

各位大大好:

小妹在使用EXCEL分析資料時出現有關圖表中資料標籤的困難,首先,若我們僅有一個變數要分析的話就沒有此問題,因為當電腦游標指向需要查詢處便會自動顯示資料標籤,如下圖一

圖一

Q1.png
2015-12-11 12:01

各位大大好:

抱歉上面沒打完就按到送出了,超過三分鐘不能編輯><,下面是完整的內容~

小妹在使用EXCEL分析資料時出現有關圖表中資料標籤的困難,首先,若我們僅有一個變數要分析的話就沒有此問題,
因為當電腦游標指向需要查詢處便會自動顯示資料標籤,如下圖一

Q1.png
2015-12-11 12:21


但是當變數資料一多的時候,EXCEL僅能顯示一個變數的資料標籤,使得在趨勢分析上相當困難,如下圖二

Q2.png
2015-12-11 12:04


EXCEL也有顯示所有資料標籤的功能,但因為資料繁多使得圖表完全沒有可讀性,見圖三。

Q5.png
2015-12-11 12:05


小妹嘗試很久也沒有僅顯示一筆資料標籤的功能,不知各位大大是否在程式中有方法可以讓EXCEL有類似下圖四看盤軟體中類似移動查價線的效果,

Q3.png
2015-12-11 12:08


下圖五是小妹希望最後的功能以及附件,麻煩有勞各位大大,我很需要這個功能~~~

Q4.png
2015-12-11 12:10


Index.zip (77.95 KB)

TOP

回復 2# 栗栗子
參考以下資訊是否就是妳所構思的模式?
K 線股票圖如何能與主力、散戶、及成交量線共存?

TOP

你自己可以去寫一個

GIF2.gif
2015-12-12 14:27

TOP

回復 2# 栗栗子
新增物件類別模組,命名 EventClassModule
  1. Private WithEvents myChartClass As Chart
  2. Private myVLine As Object
  3. Private myTarget As Range

  4. Public Sub InitializeChart(objChart As Object, rngTarget As Range)
  5.     Set myChartClass = objChart
  6.     Set myTarget = rngTarget
  7.    
  8.     On Error Resume Next
  9.     Set myVLine = myChartClass.Shapes("vline")
  10.     On Error GoTo 0
  11.    
  12.     If myVLine Is Nothing Then
  13.         With myChartClass.PlotArea
  14.             Set myVLine = myChartClass.Shapes.AddLine(.InsideLeft, .InsideTop, .InsideLeft, .InsideTop + .InsideHeight)
  15.             myVLine.Name = "vline"
  16.         End With
  17.     End If
  18. End Sub

  19. Private Sub myChartClass_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
  20.     Dim pt_x As Double, interval As Double, indx As Long
  21.     Dim arValues
  22.    
  23.     pt_x = 75 * x / ActiveWindow.Zoom
  24.     interval = myChartClass.PlotArea.InsideWidth / UBound(myChartClass.SeriesCollection(1).XValues)
  25.     indx = Application.RoundUp((pt_x - myChartClass.PlotArea.InsideLeft) / interval, 0)
  26.     indx = Application.Min(Application.Max(1, indx), UBound(myChartClass.SeriesCollection(1).XValues))
  27.         
  28.     With myChartClass.SeriesCollection
  29.         If .Count = 0 Then Exit Sub
  30.         For i = 1 To .Count
  31.             With .Item(i)
  32.                 .ApplyDataLabels Type:=xlDataLabelsShowNone
  33.                 .Points(indx).ApplyDataLabels Type:=xlDataLabelsShowValue
  34.                 .Points(indx).DataLabel.Format.Fill.ForeColor.RGB = RGB(255, 255, 0)
  35.                 arValues = .Values
  36.                 If i <= myTarget.Cells.Count Then myTarget.Cells(i + 1).Value = arValues(indx)
  37.             End With
  38.         Next
  39.         arValues = .Item(1).XValues
  40.         myTarget.Cells(1).Value = arValues(indx)
  41.     End With
  42.    
  43.     With myChartClass
  44.         If .Axes(xlCategory).AxisBetweenCategories Then
  45.             myVLine.Left = .PlotArea.InsideLeft + (indx - 0.5) * interval
  46.         Else
  47.             myVLine.Left = .PlotArea.InsideLeft + (indx - 1) * interval
  48.         End If
  49.     End With
  50. End Sub
複製代碼
一般模組:
  1. Dim myChart As EventClassModule

  2. Sub TriggerChartVLine()
  3.     With Sheets(1)
  4.         Set myChart = New EventClassModule
  5.         myChart.InitializeChart .ChartObjects(1).Chart, .Range("U15:U18")
  6.     End With
  7. End Sub

  8. Sub Auto_Open()
  9.     TriggerChartVLine
  10. End Sub
複製代碼
Index.zip (93.23 KB)
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

回復 3# c_c_lai

C大您好:

因為小妹才剛加入沒有多久,積分不夠下載附件,

請問有其他方法可以下載嗎><,還是只能等積分到50之後才能拜讀了:'( :'(

TOP

回復 5# stillfish00

S大您好:
非常感謝您,問題解決了><,但還不太熟悉物件模組的使用方法,小妹會好好研究的∼∼∼

Index.zip (93.02 KB)

TOP

本帖最後由 c_c_lai 於 2015-12-17 18:53 編輯

回復 6# 栗栗子
加油!多多參與討論自會有所收穫的。
另外在 stillfish00 大大 模組 (Module1)
裡再加上  .ChartObjects(1).Activate,
如此滑鼠只要在圖表上滑動,指引線
即刻有類似移動的效果,亦即一進入
本表單立即啟動指引線有類似移動的效果
  1. Sub TriggerChartVLine()
  2.     With Sheets(1)
  3.         Set myChart = New EventClassModule
  4.         myChart.InitializeChart .ChartObjects(1).Chart, .Range("U15:U18")
  5.         .ChartObjects(1).Activate    '  一進入本表單指引線即刻有類似移動的效果
  6.     End With
  7. End Sub
複製代碼

TOP

回復 5# stillfish00
S大您好:
在研究的過程中小妹又遇到了以下問題QQ,請大大們幫忙解惑 ><

1.就是說折線圖中的XValues值是連續的,也就是XValues從2012/10/16~2015/9/16是不間斷的值,但因為股市會休市的關係,交易日期是不連續的,導致XValues大於總筆數720筆。
   因此indx指向日期會產生偏差。目前小妹的解決方式是將用A欄日期放到陣列(XValueOutZero)中,再用indx指向此陣列(XValueOutZero)。下面是小妹加的程式碼
  1. Private Sub myChartClass_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
  2.     Dim pt_x As Double, interval As Double, indx As Long
  3.     Dim arValues, XValueOutZero
  4.    
  5.     XValueOutZero = Range("A2:A721").Value
  6.     pt_x = 75 * x / ActiveWindow.Zoom
  7.     interval = myChartClass.PlotArea.InsideWidth / UBound(myChartClass.SeriesCollection(1).XValues) '傳回此陣列之維度之最高可用註標(索引)
  8.     indx = Application.RoundUp((pt_x - myChartClass.PlotArea.InsideLeft) / interval, 0)
  9.     indx = Application.Min(Application.Max(1, indx), UBound(myChartClass.SeriesCollection(1).XValues))
  10.    
  11.     With myChartClass.SeriesCollection
  12.         If .Count = 0 Then Exit Sub
  13.         For i = 1 To .Count
  14.             With .Item(i)
  15.                 .ApplyDataLabels Type:=xlDataLabelsShowNone
  16.                 .Points(indx).ApplyDataLabels Type:=xlDataLabelsShowValue
  17.                 .Points(indx).DataLabel.Format.Fill.ForeColor.RGB = RGB(255, 255, 0)
  18.                 arValues = .Values
  19.                 If i <= myTarget.Cells.Count Then myTarget.Cells(i + 1).Value = arValues(indx)
  20.             End With
  21.         Next
  22.         'arValues = .Item(1).XValues
  23.         myTarget.Cells(1).Value = XValueOutZero(indx, 1)
  24.     End With
  25.     myVLine.Line.ForeColor.RGB = RGB(0, 0, 0)
  26.     myVLine.Line.Weight = 0.25
  27.     With myChartClass
  28.         If .Axes(xlCategory).AxisBetweenCategories Then
  29.             myVLine.Left = .PlotArea.InsideLeft + (indx - 0.5) * interval
  30.         Else
  31.             myVLine.Left = .PlotArea.InsideLeft + (indx - 1) * interval
  32.         End If
  33.     End With
  34. End Sub
複製代碼
但是這樣子又發現vline無法精準的指向正確的日期,如圖1,vline指向的日期應該是2015/5/16,但是卻顯示2015/5/19的日期:'(

2. 另外,myChartClass_MouseMove是在進入滑鼠在圖表中移動這個事件發生時所執行的程式,它需要有4個傳入值
  1. myChartClass_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
複製代碼
,但在滑鼠在圖表移動時並沒有執行其它程式碼,那麼 myChartClass_MouseMove 是怎麼得到這些傳入值的呢,這些傳入值又是什麼 ?

3. 最後想請問大大下面這段程式的用意是什麼 >< ?
  1.     With myChartClass
  2.         If .Axes(xlCategory).AxisBetweenCategories Then
  3.             myVLine.Left = .PlotArea.InsideLeft + (indx - 0.5) * interval
  4.         Else
  5.             myVLine.Left = .PlotArea.InsideLeft + (indx - 1) * interval
  6.         End If
  7.     End With
  8. End Sub
複製代碼
以上問題小妹百思不得其解,求助大大們,問題多又笨也請各位大大海涵:Q :Q

TOP

回復 9# 栗栗子
1. 能附檔案看看比較好,或是試試改成這樣
  1. Private Sub myChartClass_MouseMove(ByVal Button As Long, ByVal Shift As Long, ByVal x As Long, ByVal y As Long)
  2.     Dim pt_x As Double, interval As Double, indx As Long
  3.     Dim arValues, targetX
  4.     Dim isAxisBetween As Boolean, dataCount As Long, diffX, xOffset
  5.    
  6.     pt_x = 75 * x / ActiveWindow.Zoom
  7.    
  8.     With myChartClass
  9.         If .SeriesCollection.Count = 0 Then Exit Sub
  10.         isAxisBetween = .Axes(xlCategory).AxisBetweenCategories '座標軸位置 刻度間:True 刻度上:False
  11.         arValues = .SeriesCollection(1).XValues '日期資料
  12.         dataCount = UBound(arValues)    '資料數目
  13.         With .Axes(xlCategory)
  14.             diffX = .MaximumScale - .MinimumScale
  15.             xOffset = IIf(isAxisBetween, 0.5 * myChartClass.PlotArea.InsideWidth / (diffX + 1), 0)
  16.             If pt_x < myChartClass.PlotArea.InsideLeft + xOffset Then
  17.                 indx = 1
  18.             Else
  19.                 targetX = .MinimumScale + diffX * (pt_x - myChartClass.PlotArea.InsideLeft - xOffset) / (myChartClass.PlotArea.InsideWidth - 2 * xOffset)
  20.                 indx = Application.Match(targetX, arValues, 1)
  21.                 If indx < UBound(arValues) Then
  22.                     If Abs(targetX - arValues(indx + 1)) < Abs(targetX - arValues(indx)) Then indx = indx + 1   '修正最近資料點
  23.                 End If
  24.             End If
  25.             
  26.         End With
  27.         myVLine.Left = .PlotArea.InsideLeft + xOffset + (.PlotArea.InsideWidth - 2 * xOffset) * (arValues(indx) - arValues(1)) / CDbl(diffX)
  28.         myTarget.Cells(1).Value = arValues(indx)
  29.         For i = 1 To .SeriesCollection.Count
  30.             With .SeriesCollection(i)
  31.                 .ApplyDataLabels Type:=xlDataLabelsShowNone
  32.                 .Points(indx).ApplyDataLabels Type:=xlDataLabelsShowValue
  33.                 .Points(indx).DataLabel.Format.Fill.ForeColor.RGB = RGB(255, 255, 0)
  34.                 arValues = .Values
  35.                 If i < myTarget.Cells.Count Then myTarget.Cells(i + 1).Value = arValues(indx)
  36.             End With
  37.         Next
  38.     End With
  39. End Sub
複製代碼
2. MouseMove 是 Chart(圖表) 內建的事件,當滑鼠指標在圖表上的位置改變時會自動觸發此事件。
    事件的參數會自己傳入,你只要知道傳入的東西到底是代表什麼。
    各參數說明可以自己F1查 MouseMove得知。
    Button  : 事件發生時,滑鼠按鍵狀態
    Shift : 事件發生時 SHIFT、CTRL 和 ALT 鍵的狀態
    x : 滑鼠指標在圖表物件工作區座標中的 X 座標。
    y : 滑鼠指標在圖表物件工作區座標中的 Y 座標。
3. 是因為座標軸格式中,座標軸位置分為刻度上和刻度與刻度間相距兩種,會影響資料點位置。
表達不清、題意不明確、沒附檔案格式、沒有討論問題的態度~~~~~~以上愛莫能助。

TOP

        靜思自在 : 知識要用心體會,才能變成自己的智慧。
返回列表 上一主題