如何制作范围条形图

Question

嘿，我是论坛的新手，这是我的第一篇文章。我是 excel 中的 vba 新手，但在 ThinkorSwim 中写过 thinkscript。

如果有人熟悉区间股票图表，那就是我所追求的。

我找到了折线图的代码，并且正在使用它，但它基于任何给定时间的价格。我想将此折线图修改为仅在值高于或低于某个范围时绘制值，以便它类似于没有灯芯的烛台图。一旦数据进入该范围，我只希望它在该范围内出现新的高点或低点时更新。需要预设范围（例如 50 个刻度）一旦超出范围，我希望将数据绘制在下一个范围内，然后重复该过程。时间和日期应该被忽略，并且只根据价格行为绘制。

有人有什么想法吗？

Option Explicit

'Update the values between the quotes here:
Private Const sChartWSName = "Chart"
Private Const sSourceWSName = "Sheet1"
Private Const sTableName = "tblValues"
Public RunTime As Double

Private Sub Chart_Setup()
'Create the structure needed to preserve and chart data
    Dim wsChart As Worksheet
    Dim lstObject As ListObject
    Dim cht As Chart
    Dim shp As Button
    'Create sheet if necessary
    Set wsChart = Worksheets.Add
    wsChart.Name = sChartWSName
    'Set up listobject to hold data
    With wsChart
        .Range("A1").Value = "Time"
        .Range("B1").Value = "Value"
        Set lstObject = .ListObjects.Add( _
                        SourceType:=xlSrcRange, _
                        Source:=.Range("A1:B1"), _
                        xllistobjecthasheaders:=xlYes)
        lstObject.Name = sTableName
        .Range("A2").NumberFormat = "h:mm:ss AM/PM (mmm-d)"
        .Columns("A:A").ColumnWidth = 25
        .Select
    End With
    'Create the chart
    With ActiveSheet
        .Shapes.AddChart.Select
        Set cht = ActiveChart
        With cht
            .ChartType = xlLine
            .SetSourceData Source:=Range(sTableName)
            .PlotBy = xlColumns
            .Legend.Delete
            .Axes(xlCategory).CategoryType = xlCategoryScale
            With .SeriesCollection(1).Format.Range
                .Visible = msoTrue
                .Weight = 1.25
            End With
        End With
    End With
    'Add buttons to start/stop the routine
    Set shp = ActiveSheet.Buttons.Add(242.25, 0, 83.75, 33.75)
    With shp
        .OnAction = "Chart_Initialize"
        .Characters.Text = "Restart Plotting"
    End With
    Set shp = ActiveSheet.Buttons.Add(326.25, 0, 83.75, 33.75)
    With shp
        .OnAction = "Chart_Stop"
        .Characters.Text = "Stop Plotting"
    End With
End Sub

Public Sub Chart_Initialize()
'Initialize the routine
Dim wsTarget As Worksheet
Dim lstObject As ListObject

'Make sure worksheet exists
On Error Resume Next
Set wsTarget = Worksheets(sChartWSName)
If Err.Number <> 0 Then
    Call Chart_Setup
    Set wsTarget = Worksheets(sChartWSName)
End If
On Error GoTo 0

'Check if chart data exists
With Worksheets(sChartWSName)
    Set lstObject = .ListObjects(sTableName)
    If lstObject.ListRows.Count > 0 Then
        Select Case MsgBox("You already have data.  Do you want to clear it and start fresh?", vbYesNoCancel, "Clear out old data?")

            Case Is = vbYes
                'User wants to clear the data
                lstObject.DataBodyRange.Delete

            Case Is = vbCancel
                'User cancelled so exit routine
                Exit Sub

            Case Is = vbNo
                'User just wants to append to existing table
        End Select
    End If

    'Begin appending
    Call Chart_AppendData
End With
End Sub

Private Sub Chart_AppendData()
'Append data to the chart table
Dim lstObject As ListObject
Dim lRow As Long

With Worksheets(sChartWSName)
    Set lstObject = .ListObjects(sTableName)
    If lstObject.ListRows.Count = 0 Then
        lRow = .Range("A1").End(xlDown).Row
    End If
    If lRow = 0 Then
        lRow = .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Row
    End If
    If lRow > 2 Then
        If .Range("B" & lRow - 1).Value = Worksheets(sSourceWSName).Range("C10").Value Then
            'Data is a match, so do nothing
        Else
            'Data needs appending
            .Range("A" & lRow).Value = CDate(Now)
            .Range("B" & lRow).Value = Worksheets(sSourceWSName).Range("C10").Value
        End If
    Else
            'Data needs appending
            .Range("A" & lRow).Value = CDate(Now)
            .Range("B" & lRow).Value = Worksheets(sSourceWSName).Range("C10").Value
    End If
End With

RunTime = Now + TimeValue("00:00:01")
Application.OnTime RunTime, "Chart_AppendData"
End Sub

Public Sub Chart_Stop()
'Stop capturing data
On Error Resume Next
Application.OnTime EarliestTime:=RunTime, Procedure:="Chart_AppendData", Schedule:=False
End Sub

Answer 1

获取您的数据表并过滤...例如：

Columns("A:C").Sort key1:=Range("C2"), _
  order1:=xlAscending, header:=xlYes

排序信息：https://msdn.microsoft.com/en-us/library/office/ff840646.aspx

然后您可以定义以选择您想要的范围。假设 A 列是 x 轴，B 列是 y 轴（需要评估您的修改参数）：

Dim High1 as integer
Dim Low1 as integer

High1 = Match(Max(B:B),B:B)  'This isn't tested, just an idea
Low1 = Match(Max(B:B)+50,B:B)  'Again, not tested

并使用那些定义的参数：

.Range(Cells(High1,1),Cells(Low1,2).Select

这应该为 High1/Low1 提供一个想法，您可以在其中研究如何定义出现最大值的行。

然后为所需的图表创建对象，选择要使用的数据范围。