EXCEL VBA宏编辑

Question

我需要这个宏从 2 个（或更多）单元格引用中生成 2 个（或更多）数据列。目前它只从一个单元格引用中执行一个数据系列。该脚本每秒生成一个表格并使用新数据条目更新表格，然后使用表格数据更新图表。单元格值是实时变化的。

这应该是一个简单的修复，但我无法弄清楚代码。我不在我的联盟。任何帮助都是极好的。也许有人可以重构这个，或者至少给我一些关于我应该做什么的提示。

Option Explicit
'Update the values between the quotes here:
Private Const sChartWSName = "Chart"
Private Const sSourceWSName = "Tickers"
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"
        .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.Line
                .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
        .Range("A" & lRow).value = CDate(Now)
        .Range("B" & lRow).value = Worksheets(sSourceWSName).Range("M4").value
    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

这是“ThisWorkbook”中的 sn-p

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Stop workbook refreshing
Call Chart_Stop
End Sub

Answer 1

我希望这会有所帮助。

    Option Explicit
'Update the values between the quotes here:
Private Const sChartWSName = "Chart"
Private Const sSourceWSName = "Tickers"
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 = "Value1"
'**** I added C! and changed "Value" to "Value1" and "Value2"
        .Range("C1").Value = "Value2"
'**** I increased the range of the chart below to C1
        Set lstObject = .ListObjects.Add( _
                        SourceType:=xlSrcRange, _
                        Source:=.Range("A1:C1"), _
                        xllistobjecthasheaders:=xlYes)
        lstObject.Name = sTableName
        .Range("A2").NumberFormat = "h:mm:ss"
        .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.Line
                .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
Public 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
        .Range("A" & lRow).Value = CDate(Now)
        .Range("B" & lRow).Value = 4
        .Range("C" & lRow).Value = 5
'******I used the two line above to test results, uncomment the line below and feel free to change M5 to any other renge location workd best for you
'        .Range("B" & lRow).Value = Worksheets(sSourceWSName).Range("M4").Value
'        .Range("C" & lRow).Value = Worksheets(sSourceWSName).Range("M5").Value
    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