12
返回列表 上一主題 發帖

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

栗栗子

帖子
6 
主題
1 
精華
0 
積分
50 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
女 
來自
Taiwan 
註冊時間
2015-12-10 
最後登錄
2017-10-19 
1# 跳轉到 » 倒序看帖
打印
tT
發表於 2015-12-11 12:02 | 只看該作者

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

各位大大好：

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

收藏 分享

栗栗子

帖子
6 
主題
1 
精華
0 
積分
50 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
女 
來自
Taiwan 
註冊時間
2015-12-10 
最後登錄
2017-10-19 
2#
發表於 2015-12-11 12:23 | 只看該作者
各位大大好：

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

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



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



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



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



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



Index.zip (77.95 KB)

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
3#
發表於 2015-12-12 11:42 | 只看該作者
回復 2# 栗栗子
參考以下資訊是否就是妳所構思的模式？
K 線股票圖如何能與主力、散戶、及成交量線共存？

TOP

jackyq

帖子
319 
主題
6 
精華
0 
積分
309 
點名
0  
作業系統
xp 
軟體版本
2k 
閱讀權限
20 
性別
男 
註冊時間
2015-6-24 
最後登錄
2024-4-27 
4#
發表於 2015-12-12 14:28 | 只看該作者
你自己可以去寫一個

GIF2.gif

TOP

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
5#
發表於 2015-12-15 12:14 | 只看該作者
回復 2# 栗栗子
新增物件類別模組，命名 EventClassModule
  1. Private WithEvents myChartClass As Chart
  2. Private myVLine As Object
  3. Private myTarget As Range

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

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

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

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

TOP

栗栗子

帖子
6 
主題
1 
精華
0 
積分
50 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
女 
來自
Taiwan 
註冊時間
2015-12-10 
最後登錄
2017-10-19 
6#
發表於 2015-12-17 14:50 | 只看該作者
回復 3# c_c_lai

C大您好：

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

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

TOP

栗栗子

帖子
6 
主題
1 
精華
0 
積分
50 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
女 
來自
Taiwan 
註冊時間
2015-12-10 
最後登錄
2017-10-19 
7#
發表於 2015-12-17 15:41 | 只看該作者
回復 5# stillfish00

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

Index.zip (93.02 KB)

TOP

c_c_lai

帖子
2035 
主題
24 
精華
0 
積分
2031 
點名
0  
作業系統
Win7 
軟體版本
Office2010 
閱讀權限
100 
性別
男 
註冊時間
2012-3-22 
最後登錄
2024-2-1 
8#
發表於 2015-12-17 18:50 | 只看該作者
本帖最後由 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

栗栗子

帖子
6 
主題
1 
精華
0 
積分
50 
點名
0  
作業系統
Windows 7 
軟體版本
Office 2007 
閱讀權限
20 
性別
女 
來自
Taiwan 
註冊時間
2015-12-10 
最後登錄
2017-10-19 
9#
發表於 2015-12-22 09:35 | 只看該作者
回復 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

stillfish00

帖子
1018 
主題
15 
精華
0 
積分
1058 
點名
0  
作業系統
win7 32bit 
軟體版本
Office 2016 64-bit 
閱讀權限
50 
性別
男 
來自
桃園 
註冊時間
2012-5-9 
最後登錄
2022-9-28 
10#
發表於 2015-12-23 17:30 | 只看該作者
回復 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

        靜思自在 : 能幹不幹，不如苦幹實幹。
12
返回列表 上一主題