如何在Excel中将范围转换为单调列表

时间:2016-10-17 20:58:58

标签: excel vba excel-vba excel-formula

我有一系列在Excel中看起来像这样的单元格

Start   End     Cat 1   Cat 2   Value
2011    2015    1       1       2.09
2011    2015    1       2       1.71
2011    2015    2       1       0.66
2011    2015    2       2       2.07
2011    2015    3       1       0.66
2011    2015    3       2       2.07
2016    2020    1       1       3.72
2016    2020    1       2       2.22
2016    2020    2       1       1.38
2016    2020    2       2       2.34
2016    2020    3       1       1.38
2016    2020    3       2       2.34
...

例如,第一行意味着对于2011-2015的所有年份,值2.09对[category1 = 1][category2 = 1]有效(忽略类别对于问题的目的意味着什么)。

我想要的是扩展列表,使其看起来像这样

Year    Cat 1   Cat 2   Value
2011    1       1       2.09
2011    1       2       1.71
2011    2       1       0.66
2011    2       2       2.07
2011    3       1       0.66
2011    3       2       2.07
2012    1       1       2.09
2012    1       2       1.71
2012    2       1       0.66
2012    2       2       2.07
2012    3       1       0.66
2012    3       2       2.07
...

即。它复制第一个范围(2011-2015)中每个值的类别1,类别2和值列,然后复制第二个年度(2016-2020)的第二组列,依此类推。 / p>

最好的方法是什么?是否有一些我可以应用的Excel公式技巧或是写一些宏的最佳方法?

2 个答案:

答案 0 :(得分:2)

这是一种快速闪电并提供所需输出的不同方法:

Sub MakeNewTable()

Dim k As Long, i As Long, j As Long, r As Long
Dim sh1 As Worksheet, sh2 As Worksheet
Dim maxYear As Long, minYear As Long, nrow As Long
Dim groups() As Double, myData As Variant

    Set sh1 = Sheets("Sheet1")
    Set sh2 = Sheets("Sheet2")
    myData = sh1.UsedRange '' Put your range here
    nrow = UBound(myData, 1)

    minYear = Application.WorksheetFunction.Min(Range(sh1.Cells(2, 1), sh1.Cells(nrow + 1, 1)))
    maxYear = Application.WorksheetFunction.Max(sh1.Range(sh1.Cells(2, 2), sh1.Cells(nrow + 1, 2)))

    ReDim groups(minYear To maxYear, 1 To 3, nrow)

    For i = nrow To 2 Step -1
        For j = myData(i, 1) To myData(i, 2)
            For k = 1 To 3: groups(j, k, i) = myData(i, k + 2): Next k
            groups(j, 1, 1) = i  '' Getting first time a value appears... Used in loop below
            If i > groups(j, 2, 1) Then groups(j, 2, 1) = i  '' Getting last time a value appears
        Next j
    Next i

    k = 2

    For i = minYear To maxYear
        For j = groups(i, 1, 1) To groups(i, 2, 1)
            If groups(i, 1, j) > 0 Then
                sh2.Cells(k, 1) = i
                For r = 1 To 3: sh2.Cells(k, r + 1) = groups(i, r, j): Next r
                k = k + 1
            End If
        Next j
    Next i

End Sub

它利用存储和操作数组中的数据,因此所有繁重的工作都是在本地完成的。我通过创建一个名为groups的分组数组来保持数据的组织,该数组利用索引来快速组织数据。应该注意的是,这种算法也非常通用,这意味着,如果数据已经很好地划分了多年并不重要。例如,此算法适用于以下表格:

Start    End
 2011   2015 ...
 2008   2013 ...
 2018   2021 ...
 2011   2015 ...
 1991   2003 ...
 1998   2000 ...
    etc. 

答案 1 :(得分:1)

如果你没有完全按照列出的方式排序输出(换句话说,每行会扩展到该范围,然后移动到下一行),这样的事情就可以了:

Sub ExpandRanges()

  Dim ws1, ws2 As Worksheet
  Dim row1, row2, year As Integer

  Set ws1 = Sheets("Sheet2")
  Set ws2 = Sheets("Sheet3")

  row1 = 2
  row2 = 2

  While ws1.Cells(row1, 1).Value <> ""
    For year = ws1.Cells(row1, 1).Value2 To ws1.Cells(row1, 2).Value2
      ws2.Cells(row2, 1).Value = year
      ws2.Range("B" & row2 & ":D" & row2).Value = ws1.Range("C" & row1 & ":E" & row1).Value
      row2 = row2 + 1
    Next year

    row1 = row1 + 1
  Wend

End Sub

如果你确实需要按年份订购,那么快速排序也可以实现这一目标。