我有一系列在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公式技巧或是写一些宏的最佳方法?
答案 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
如果你确实需要按年份订购,那么快速排序也可以实现这一目标。