【问题标题】:VBA Macro to change vertical axis in column chart to the minimum and maximum values in selectionVBA宏将柱形图中的垂直轴更改为选择中的最小值和最大值
【发布时间】:2013-05-31 20:03:34
【问题描述】:

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

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

但是,我希望纵轴为 1-5,横轴为频率值(即该数字出现的次数)。我该怎么做?

另外,我是 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

【问题讨论】:

  • 您实际上需要的是直方图,而不是条形图。 Excel 没有内置的图表样式,可以将您的数据更改为直方图形式。
  • 伙计,我希望不是这样。我会做一些研究
  • 按照我下面的回答,你可以用Excel先把你的数据转成直方图,然后再做图表,但你不能一步到位。

标签: excel vba


【解决方案1】:

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

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

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

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

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

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

编辑

有一个位于here 的代码项目文章/提示/技巧,它几乎可以帮助您实现解决方案的自动化。

【讨论】:

  • 谢谢 Stewbob!我正在为一家公司开发此功能,该公司将在公司的整个生命周期内为数百次不同的调查执行此操作,因此手动执行此操作是不可能的。这个网站:sitestory.dk/excel_vba/histogram-vba.htm 似乎暗示这是可能的,但我很难适应代码
  • 你在这篇文章之后写了那篇代码项目文章吗?如果是这样,很棒的工作!我从这个项目中短暂中断过,但现在我要回来了。有问题可以私信你吗?
  • 是的,CP 文章是针对这个 SO 问题而写的,但是代码已经存在多年了。
【解决方案2】:

为了后代,我创建了一个生成直方图的宏,假设箱数 = 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

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 2023-03-03
    • 2014-01-03
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 1970-01-01
    • 2022-01-02
    • 1970-01-01
    相关资源
    最近更新 更多