线性系列填充的Excel宏

时间:2014-10-27 15:30:07

标签: excel excel-vba fill series vba

我在excel中有一组数据。按年计算的人口数百万,但我需要填补的数据存在差距。见下面的例子

Year--2013--2014--2015--2016--2017--2018--2019--2020
Male--   5--    --   7--    --    --   8--    --  10
 Fem--   4--    --   5--    --    --   7--    --   9

我知道我可以使用Fill / Series / Linear,但我需要在2000 - 2050年间为数百个国家/地区执行此操作。我试着录制一个我这样做的宏,但是Step Value似乎是硬编码的。

这是可能的吗?还是我咬紧牙关并手动继续?

由于

Ĵ

Sub FillTheGaps()
'
' fill the gaps Macro
'

'start at cell A2
'find first gap on that row
Selection.End(xlToRight).Select
'select up to and including next non-blank
Range(Selection, Selection.End(xlToRight)).Select
Selection.DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step _
    :=11845, Trend:=False
Selection.End(xlToLeft).Select
'move down to next row
ActiveCell.Offset(1).Select
Selection.End(xlToRight).Select
'select up to and including next non-blank
Range(Selection, Selection.End(xlToRight)).Select
Selection.DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step _
    :=8598, Trend:=False
Selection.End(xlToLeft).Select
'move down to next row
ActiveCell.Offset(1).Select
Selection.End(xlToRight).Select
'select up to and including next non-blank
Range(Selection, Selection.End(xlToRight)).Select
Selection.DataSeries Rowcol:=xlRows, Type:=xlLinear, Date:=xlDay, Step _
    :=30400, Trend:=False
'move down to next row
ActiveCell.Offset(1).Select
End Sub

1 个答案:

答案 0 :(得分:0)

我认为这应该让你开始。我所做的是创建一个循环,并根据您的解释进行一些计算以获得步长值,因为这实际上是唯一的“变量”。其余的是Excel中的how to avoid using or relying on the Selection method练习;我创建一个变量rng来表示每行/每个数据范围,然后使用适当的方法来定义该范围,而不是依赖于手动用户选择范围。

Dim rng As Range
Dim stepValue As Long

Set rng = Range("A2", Range("A2").End(xlToRight))

Do
   'Compute the difference between the first & last cell in the range,
   ' divided by the number of blank cells + 1.
   stepValue = (rng(rng.Cells.Count).Value - rng(1).Value) / _
            (rng.SpecialCells(xlCellTypeBlanks).Count + 1)

   'now we can use our computed "stepValue" instead of hard-coding it as a constant:
   '## Use the resize method to avoid overwriting the last cell in this range
    rng.Resize(, rng.Cells.Count - 1).DataSeries Rowcol:=xlRows, _
               Type:=xlLinear, _
               Date:=xlDay, _
               Step:=stepValue, _
               Trend:=False


   'Increment the range to the next row 
   Set rng = Range(rng(1).Offset(1), rng(1).Offset(1).End(xlToRight))

'Escape the loop only when we reach an empty/blank cell in the first column:
Loop Until Trim(rng(1).Value) = vbNullString