时间戳

首页 > 解决方案 > 如何将范围选择从 4 减少到 2 以创建图表 VBA？

arrays - 如何将范围选择从 4 减少到 2 以创建图表 VBA？

问题描述

我有两列数据，其中一列包含一半负数和一半正数。我使用以下代码为数据创建了一个图表（带有直线和标记的散点图）：

Sub Test2()

    Dim xData As Range
    Dim yData As Range
    Dim x2Data As Range
    Dim y2Data As Range
    Dim serName As Range


    'set the ranges to get the data and y value label

    Set xData = Application.Selection
    Set yData = Application.Selection
    Set x2Data = Application.Selection
    Set y2Data = Application.Selection

    Set serName = Range("AY2")


    'define range
    Set xData = Application.InputBox("xvalues", , xData.Address, Type:=8)
    Set yData = Application.InputBox("yvalues", , yData.Address, Type:=8)
    Set x2Data = Application.InputBox("x2values", , x2Data.Address, Type:=8)
    Set y2Data = Application.InputBox("y2values", , y2Data.Address, Type:=8)


    'get reference to ActiveSheet
    Dim sht As Worksheet
    Set sht = ActiveSheet

    'create a new ChartObject at position (4100, 195) with width 400 and height 300
    Dim chtObj As ChartObject
    Set chtObj = sht.ChartObjects.Add(4100, 195, 400, 300)

    'get reference to chart object
    Dim cht As Chart
    Set cht = chtObj.Chart

    'create the new series
    Dim ser As Series
    Set ser = cht.SeriesCollection.NewSeries

    ser.Values = yData
    ser.XValues = xData
    ser.Name = positivedcf
    ser.ChartType = xlXYScatterLines

    'create second series

    Dim ser2 As Series
    Set ser2 = cht.SeriesCollection.NewSeries

    ser2.Values = y2Data
    ser2.XValues = x2Data
    ser2.Name = negativedcf
    ser2.ChartType = xlXYScatterLines




End Sub

如您所见，为了正确绘制图表，我使用了 4 个选项。它涉及一次选择每列的一部分。我现在想做的是创建相同的图表，但我不想使用 4 个选项，而是只使用 2 个选项。理想情况下，这 2 个选择将只是选择整个两列。我也想使用数组来实现这一点。

谁能帮我解决这个问题？如果它对你有帮助，我可以附上我用来创建初始图表的数据图片。非常感谢您提前。

***编辑****

所以我在下面尝试了这个，最终在 1 个选项中制作了图表，这很棒。然而，原始图表以不同颜色显示了曲线的正负部分。我基本上使用 2 个系列创建了原始图形，它们都在 y=0 处相遇，给出了所有这些都是一条曲线的效果，而理论上它是 2 条不同的曲线。如果这有意义吗？

那么有没有办法做同样的事情：基本上使用在 y=0 处相遇的 2 个系列创建图形，以不同的颜色显示曲线的正负部分，有 2 个选择（理想情况下只是突出显示完整）而不是我原来的 4 个选择？

Sub Test2()

    Dim xData As Range
    Dim yData As Range
    Dim serName As Range

    Dim TotalData As Range



    'set the ranges to get the data and y value label

    Set xData = Application.Selection
    Set yData = Application.Selection
    Set TotalData = Application.Selection




    'define range


    Set TotalData = Application.InputBox("AY3:AZ62", , TotalData.Address, Type:=8)
    Set yData = TotalData.Resize(ColumnSize:=1)
    Set xData = TotalData.Resize(ColumnSize:=1).Offset(ColumnOffset:=1)



    'get reference to ActiveSheet
    Dim sht As Worksheet
    Set sht = ActiveSheet

    'create a new ChartObject at position (4100, 195) with width 400 and height 300
    Dim chtObj As ChartObject
    Set chtObj = sht.ChartObjects.Add(4100, 195, 400, 300)

    'get reference to chart object
    Dim cht As Chart
    Set cht = chtObj.Chart

    'create the new series
    Dim ser As Series
    Set ser = cht.SeriesCollection.NewSeries

    ser.Values = yData
    ser.XValues = xData
    ser.Name = positivedcf
    ser.ChartType = xlXYScatterLines








End Sub

标签： arraysexcelvbaselectrange

解决方案

只需使用一个框来选择两列（x 和 y）

Set TotalData = Application.InputBox("Select all data (x and y)", , TotalData.Address, Type:=8)

然后将其拆分为 2 个单独的列（x 和 y）

Set xData = TotalData.Resize(ColumnSize:=1)
Set yData = TotalData.Resize(ColumnSize:=1).Offset(ColumnOffset:=1)

推荐阅读