vba VBA宏将柱形图中的纵轴更改为选择中的最小值和最大值

VBA Macro to change vertical axis in column chart to the minimum and maximum values in selection

提问by Parseltongue

I want to programatically generate column charts based on my selection. However, I want the vertical axis values to be the minimum and maximum values in the selection. I thought this was obtainable through WorksheetFunction.Max(DataRange)Though this does seem to adjust the horizontal axis, I'm not sure where the vertical axis values are coming from.

我想根据我的选择以编程方式生成柱形图。但是，我希望垂直轴值是选择中的最小值和最大值。我认为这可以通过WorksheetFunction.Max(DataRange)虽然这似乎调整水平轴获得，但我不确定垂直轴值来自哪里。

For example, if this is the data that I select The chart produced by the macro below looks like this:

例如，如果这是我选择的数据，下面的宏生成的图表如下所示：

However, I want the vertical axis to be 1-5 and the horizontal axis to be frequency values (i.e. how many times that number occurred). How do I do this?

但是，我希望纵轴为 1-5，横轴为频率值（即该数字出现的次数）。我该怎么做呢？

Also, I'm new to Excel so if you see improvements elsewhere, I'd appreciate input.

另外，我是 Excel 的新手，所以如果您在其他地方看到改进，我将不胜感激。

Sub GenerateGraph()

    Dim MyChart As Chart
    Dim DataRange As Range
    Set DataRange = Selection

    Set MyChart = Charts.Add
    MyChart.SetSourceData Source:=DataRange
    ActiveChart.ChartType = xlBarClustered

    With ActiveChart.Axes(xlValue, xlPrimary)
        .MaximumScale = WorksheetFunction.Max(DataRange)
        .MinimumScale = WorksheetFunction.Min(DataRange)
        .MajorUnit = 1

    End With

采纳答案by Stewbob

If you have the Analysis Toolpak loaded in Excel, you can transform your data into a histogram before you create the chart.

如果您在 Excel 中加载了分析工具库，则可以在创建图表之前将数据转换为直方图。

On the 'Data' tab of the ribbon, there will be 'Data Analysis' in the 'Analysis' panel. Click on this, and choose Histogram from the list.

在功能区的“数据”选项卡上，“分析”面板中有“数据分析”。单击它，然后从列表中选择直方图。

A wizard will start that asks for the data range, the bin range, and the output range. You can set up your bin range beforehand, which in your case would just be the numbers 1 through 5. When your data gets more complex, you can use the MINand MAXworksheet functions to help determine your bins.

将启动一个向导，询问数据范围、bin 范围和输出范围。您可以预先设置 bin 范围，在您的情况下，它只是数字 1 到 5。当您的数据变得更复杂时，您可以使用MIN和MAX工作表函数来帮助确定您的 bin。

You'll notice in the picture above that the bin range is defined with 1 blank cell above the actual data. Excel needs this extra row, but I'm not sure why. EDITThe blank row is so that you can label your bins with a column heading.

您会在上图中注意到 bin 范围定义为实际数据上方的 1 个空白单元格。Excel 需要这个额外的行，但我不知道为什么。 编辑空白行以便您可以使用列标题标记您的垃圾箱。

Once you have the output (green cells) you can easily plot that as a bar chart.

获得输出（绿色单元格）后，您可以轻松地将其绘制为条形图。

You can do all this in vba code if you want (I have in the past) but it involves some serious vba coding. I would recommend sticking with Excel's built-in functionality unless you really need to automate the entire process.

如果你愿意，你可以在 vba 代码中完成所有这些（我过去有过），但它涉及一些严重的 vba 编码。我建议坚持使用 Excel 的内置功能，除非您真的需要自动化整个过程。

EDIT

编辑

There is a Code Project Article/Tip/Trick located herethat should get you almost all of the way to automating your solution.

这里有一个代码项目文章/提示/技巧，它应该可以让您几乎完成自动化解决方案的所有方式。

回答by Parseltongue

For posterity, I created a Macro that produces a histogram, assuming the number of bins = 5 (as in a response to a survey question).

对于后代，我创建了一个生成直方图的宏，假设 bin 数量 = 5（如对调查问题的回应）。

' Make a histogram from the selected values.
' The top value is used as the histogram's title.
Sub MakeHistogramFinal()
Dim src_sheet As Worksheet
Dim new_sheet As Worksheet
Dim selected_range As Range
Dim title As String
Dim r As Integer
Dim score_cell As Range
Dim num_scores As Integer
Dim count_range As Range
Dim new_chart As Chart

    ' Add a new sheet.
    Set selected_range = Selection
    Set src_sheet = ActiveSheet
    Set new_sheet = Application.Sheets.Add(After:=src_sheet)
    title = InputBox(Prompt:="Enter Title for Histogram", _
          title:="Title Submission Form", Default:="Morning Session Summary")
    new_sheet.Name = title


    ' Copy the scores to the new sheet.
    new_sheet.Cells(1, 1) = "Data"
    r = 2
    For Each score_cell In selected_range.Cells
        new_sheet.Cells(r, 1) = score_cell
        r = r + 1
    Next score_cell
    num_scores = selected_range.Count


    'Creates the number of bins to 5
    'IDEA LATER: Make this number equal to Form data
    Dim num_bins As Integer
    num_bins = 5

    ' Make the bin separators.
    new_sheet.Cells(1, 2) = "Bins"
    For r = 1 To num_bins
        new_sheet.Cells(r + 1, 2) = Str(r)
    Next r

    ' Make the counts.
    new_sheet.Cells(1, 3) = "Counts"
    Set count_range = new_sheet.Range("C2:C" & num_bins + 1)

    'Creates frequency column for all counts
    count_range.FormulaArray = "=FREQUENCY(A2:A" & num_scores + 1 & ",B2:B" & num_bins & ")"

    'Make the range labels.
    new_sheet.Cells(1, 4) = "Ranges"
    For r = 1 To num_bins
        new_sheet.Cells(r + 1, 4) = Str(r)
        new_sheet.Cells(r + 1, 4).HorizontalAlignment = _
            xlRight
    Next r

    ' Make the chart.
    Set new_chart = Charts.Add()
    With new_chart
        .ChartType = xlColumnClustered
        .SetSourceData Source:=new_sheet.Range("C2:C" & _
            num_bins + 1), _
            PlotBy:=xlColumns
        .Location Where:=xlLocationAsObject, _
            Name:=new_sheet.Name
    End With

    With ActiveChart
        .HasTitle = True
        .HasLegend = False
        .ChartTitle.Characters.Text = title
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, _
            xlPrimary).AxisTitle.Characters.Text = "Scores"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text _
 _
            = "Count"

        ' Display score ranges on the X axis.
        .SeriesCollection(1).XValues = "='" & _
            new_sheet.Name & "'!R2C4:R" & _
            num_bins + 1 & "C4"

    End With
    ActiveChart.SeriesCollection(1).Select
    With ActiveChart.ChartGroups(1)
        .Overlap = 0
        .GapWidth = 0
        .HasSeriesLines = False
        .VaryByCategories = False

    End With

    r = num_scores + 2
    new_sheet.Cells(r, 1) = "Average"
    new_sheet.Cells(r, 2) = "=AVERAGE(A1:A" & num_scores & _
        ")"
    r = r + 1
    new_sheet.Cells(r, 1) = "StdDev"
    new_sheet.Cells(r, 2) = "=STDEV(A1:A" & num_scores & ")"
End Sub