☰

使用开始时间和结束时间创建条形图

tag-icon • tag-icon microsoft-excel charts timeline bar-chart
使用开始时间和结束时间创建条形图

我想根据以下数据创建一个条形图，其外观如附图所示。数据将具有开始时间、结束时间和数值。

样本数据：

在此处输入图片描述

条状图：
条状图

基本上，我想创建一个条形图，其中 X 轴上将显示日期和时间，并且我想查看“数字”值的范围。

我尝试使用 Excel 中的默认条形图，但它们只是单独显示每个条形图。

普通条形图：
普通条形图

答案1

实际上不能用条形图来做到这一点，但是如果您想要填充区域，则需要从下面的方法开始，然后变得复杂。

您可以将数据重新排列成三个单独的块，如下所示。选择第一个块，然后插入 XY 散点图。选择并复制第二个块，选择图表，然后使用选择性粘贴将数据添加为新系列，系列名称在第一行，X 值在第一列。对第三个块重复此操作。经过一些格式化，它看起来像下面的图表。

在此处输入图片描述

或者，您可以将数据重新排列成一个块，并在各部分之间留出一些空白行。创建 XY 散点图并进行格式化。

在此处输入图片描述

您可以从这里下载我的工作簿：带开始和结束时间的条形图.xlsx

编辑：使用 VBA 方法来安排数据。

我编写了一个 VBA 例程，它从下面屏幕截图中的第一个块之类的数据开始，进行最低限度的验证（它是否有三列，是否有标题行），询问用户需要哪个输出（每行一个系列或所有行合计一个系列），询问用户将输出放在哪里，然后生成适当的输出。输出单元格链接到输入单元格，因此如果用户更改输入范围内的值，输出值将反映更改。

它的文档很少，欢迎提问。

用户首先选择输入范围（或输入范围中的一个单元格）并运行代码。

运行代码后，用户只需选择输出范围（或输出范围中的一个单元格），然后插入带有线条而没有标记的 XY 散点图。

VBA 例程：输入和输出数据

以下是 VBA 程序：

Sub Reformat_StartTimeCount_OneSeries()
  If TypeName(Selection) <> "Range" Then
    MsgBox "Select a range of data and try again.", vbExclamation, "No Data Selected"
    GoTo ExitSub
  End If
  
  ' input range: three columns (start, end, count), one row box, maybe header row
  Dim InputRange As Range
  Set InputRange = Selection
  If InputRange.Cells.Count = 1 Then
    Set InputRange = InputRange.CurrentRegion
  End If
  If InputRange.Columns.Count <> 3 Then
    MsgBox "Select a three-column range of data and try again.", vbExclamation, "No Data Selected"
    GoTo ExitSub
  End If
  
  ' one or multiple colors
  Dim Question As String
  Question = "Do you want one series (one line color) for each row of data?"
  Question = Question & vbNewLine & vbNewLine & "(Yes for multiple colors, No for one color)"
  Dim Answer As VbMsgBoxResult
  Answer = MsgBox(Question, vbQuestion + vbYesNo, "How Many Lines")
  If Answer = vbYes Then
    Dim MultipleSeries As Long
    MultipleSeries = 1
  End If
  
  ' ignore header row
  If Not IsNumeric(InputRange.Cells(1, 3)) Then
    Dim HasHeaderRow As Boolean
    HasHeaderRow = True
    With InputRange
      Set InputRange = .Offset(1).Resize(.Rows.Count - 1)
    End With
  End If
  
  ' how many rows?
  Dim RowCount As Long
  RowCount = InputRange.Rows.Count
  
  ' build array of formulas
  Dim OutputArray As Variant
  ReDim OutputArray(1 To RowCount * (5 - MultipleSeries) + MultipleSeries, 1 To 2 + MultipleSeries * (RowCount - 1))
  
  Dim RowIndex As Long
  For RowIndex = 1 To RowCount
    Dim RowBase As Long, ColumnBase As Long
    RowBase = (RowIndex - 1) * (5 - MultipleSeries)
    ColumnBase = 2 + MultipleSeries * (RowIndex - 1)
    If MultipleSeries Then
      If HasHeaderRow Then
        OutputArray(1, ColumnBase) = "=" & InputRange.Cells(0, 3).Address(False, False) & "&"" " & RowIndex & """"
      Else
        OutputArray(1, ColumnBase) = "Count " & RowIndex
      End If
    Else
      If RowIndex = 1 Then
        If HasHeaderRow Then
          OutputArray(RowBase + 1, 2) = "=" & InputRange.Cells(0, 3).Address(False, False)
        Else
          OutputArray(RowBase + 1, 2) = "Count"
        End If
      Else
        OutputArray(RowBase + 1, 2) = "#n/a"
      End If
    End If
    OutputArray(RowBase + 2, 1) = "=" & InputRange.Cells(RowIndex, 1).Address(False, False)
    OutputArray(RowBase + 3, 1) = "=" & InputRange.Cells(RowIndex, 1).Address(False, False)
    OutputArray(RowBase + 4, 1) = "=" & InputRange.Cells(RowIndex, 2).Address(False, False)
    OutputArray(RowBase + 5, 1) = "=" & InputRange.Cells(RowIndex, 2).Address(False, False)
    OutputArray(RowBase + 2, ColumnBase) = 0
    OutputArray(RowBase + 3, ColumnBase) = "=" & InputRange.Cells(RowIndex, 3).Address(False, False)
    OutputArray(RowBase + 4, ColumnBase) = "=" & InputRange.Cells(RowIndex, 3).Address(False, False)
    OutputArray(RowBase + 5, ColumnBase) = 0
  Next
  
  ' output formulas
  Dim OutputRange As Range
  On Error Resume Next
  Set OutputRange = Application.InputBox("Select the top left cell of the output range.", "Select Output Range", , , , , , 8)
  On Error GoTo 0
  If OutputRange Is Nothing Then GoTo ExitSub
  
  With OutputRange.Resize(RowCount * (5 - MultipleSeries) + MultipleSeries, 2 + MultipleSeries * (RowCount - 1))
    .Value2 = OutputArray
    .EntireColumn.AutoFit
  End With
  
ExitSub:
End Sub

我已上传了新的练习册，其中包含答案的两个部分。请在此处下载：带开始和结束时间的条形图.xlsm

相关内容