Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


54529 / 76732 ←次へ | 前へ→

【26993】Re:グラフの異常点を削除したい
発言  ichinose  - 05/7/26(火) 6:23 -

引用なし
パスワード
   ▼nogu さん:
おはようございます。

>
>色々なデータをグラフにしています。
>グラフの種類は、散布図や折れ線です。
>
>データからグラフにするマクロは試行錯誤で出来ています。
>しかしグラフを作成した後、異常がある点を元のデータから削除したいのです。
>何故かというと異常があると他のデータのグラフのマーカーや線が見えなくなるからです。
>
>こんな方法はできるのでしょうか??
>グラフ上で異常点をクリックすると元のデータがアクティブになる。
>
>【完成した散布図】
>│   ×←1. この部分をクリック(Wクリック)すると
>│   
>│
>│  ××
>│× ××
>│×××
>│××
>│ 
>└──────────
>
>【元のデータ】
>青    赤    黄    緑
>2    3    5    4
>3    2    4    12←2.元のデータをアクティブにする
>4    2    3    5
>
>異常を探す定義は特になく、グラフをかいて(視覚的にとらえて)から
>データを削除する方法を希望としています。
>よろしくお願いいたします。
以下のようなコードで可能ですが、
系列の選択後、ポイントのダブルクリックというオペレーティングに
なってしまうので操作性がよいとは言えません。

グラフは、ワークシートに貼り付けたグラフ、
つまり、チャートオブジェクトを対象としています。

Thisworkbookのモジュールに
'========================================================
Private WithEvents evchart As Chart
'========================================================
Sub set_chart()
  Set evchart = ActiveSheet.ChartObjects(1).Chart
End Sub
'========================================================
Private Sub evchart_BeforeDoubleClick(ByVal ElementID As Long, ByVal Arg1 As Long, ByVal Arg2 As Long, Cancel As Boolean)
  Dim srs As Series
  Dim srsstr As Variant
  Dim addr As Variant
  If ElementID = xlSeries Then
    Set srs = evchart.SeriesCollection(Arg1)
    srsstr = Split(edit_addr(srs.Formula, srs.PlotOrder), ",")
    addr = srsstr(UBound(srsstr))
    Application.Range(addr).Parent.Activate
    If Arg2 > 0 Then Application.Range(addr).Cells(Arg2).Activate
    End If
  Cancel = True
End Sub
'========================================================
Function edit_addr(add, podr As Long) As String
  Dim idx As Long, jdx As Long
  Dim ans()
  Dim wk As Variant
  wk = Split(Replace$(Replace$(add, "=SERIES(", ""), "," & podr & ")", ""), ",")
  jdx = 1
  For idx = LBound(wk) To UBound(wk)
   If TypeName(Application.Evaluate(wk(idx))) = "Range" Then
    ReDim Preserve ans(1 To jdx)
    ans(jdx) = wk(idx)
    jdx = jdx + 1
    End If
   Next
  If jdx > 1 Then
   edit_addr = Join(ans(), ",")
  Else
   edit_addr = ""
   End If
End Function


対象グラフが存在するワークシートをアクティブにした状態で
上記プロシジャーのset_chartを実行してください。

実行後、グラフの変更したいプロットをダブルクリックしてください。
当該セルがアクティブになります。

確認してください。

0 hits

【26970】グラフの異常点を削除したい nogu 05/7/25(月) 17:05 質問
【26993】Re:グラフの異常点を削除したい ichinose 05/7/26(火) 6:23 発言
【65893】Re:グラフの異常点を削除したい ごん 10/7/5(月) 21:11 質問
【65914】Re:グラフの異常点を削除したい mura 10/7/6(火) 18:18 回答

54529 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free