Excel 如何在数列中填充线性空格？

我是VBA的新手，正在尝试找出如何使用VBA填充数字序列。两个数字之间的空格可以是一个或多个单元格。我想用线性的方式来填充它。请注意，百分比可以上升或下降

1............2.............3............4............5...............6.

Jan........ 4,34%.......... 4,23%..............blank..............3,21%..............5,31%..................Blank

Feb.... 10.06%...........Blank................Blank............15.41%...........17.35%...................Blank

March...Blank............5.50%..............Blank..............Blank..............7.16%....................13.21%

每一行对应于特定国家的一个月，每一列对应于该月的某一天。到目前为止，我的宏填补了空白，但我得到的数字是错误的，我不明白为什么。另外，如果B列中没有数字，则宏将在当月的第一天停止运行。 以下是我目前使用的代码的一部分，可能有很多错误，但没有经过优化：

Sub FillLinear()

Dim rng As Range
Dim stepValue As Integer

Set rng = Range("B2", Range("B2").End(xlToRight))
On Error Resume Next


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)
On Error Resume Next
   '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

On Error Resume Next

Set rng = Range("C2", Range("C2").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)
On Error Resume Next
   '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

On Error Resume Next

Set rng = Range("D2", Range("D2").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)
On Error Resume Next
   '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

On Error Resume Next

 Set rng = Range("E2", Range("E2").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)
On Error Resume Next
   '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


End Sub

---

到目前为止，除了为每一列复制粘贴相同的代码外，我没有找到任何其他解决方案。

我想建议一种稍微不同的方法。但这当然只是个人偏好。在这个解决方案中，我将从左到右和从上到下遍历所有单元格，从单元格B2开始始终对空单元格进行采样，并使用值跟踪最后一个单元格

一旦确定了两个填充单元格之间的空白区域，将调用第二个子区域来填充该区域。简言之，这就是我提出的解决方案：

Option Compare Text
Option Explicit
Option Base 0

Public Sub FillLinear()
Dim strLastRange, strToRange As String
Dim intCountBlanks As Integer
Dim lngRow, lngColumn As Long

For lngRow = 2 To 2000000000
    If IsEmpty(Cells(lngRow, 1).Value2) Then Exit For
    For lngColumn = 2 To 100
        If IsEmpty(Cells(1, lngColumn).Value2) Then Exit For
        If Cells(lngRow, lngColumn).Value2 = vbNullString Then
            If Not strLastRange = vbNullString Then
                intCountBlanks = intCountBlanks + 1
            End If
        Else
            If strLastRange = vbNullString Then
                strLastRange = Cells(lngRow, lngColumn).Address
            Else
                If intCountBlanks = 0 Then
                    strLastRange = Cells(lngRow, lngColumn).Address
                Else
                    strToRange = Cells(lngRow, lngColumn).Address
                    Call FillThemUp(strLastRange, strToRange, intCountBlanks)
                    strLastRange = strToRange
                End If
            End If
            intCountBlanks = 0
        End If
    Next lngColumn
Next lngRow

End Sub

Public Sub FillThemUp(ByVal strLastRange As String, ByVal strToRange As String, ByVal intCountBlanks As Integer)
Dim lngRow, lngColumn As Long
Dim strLastCell As String
Dim lngCountDown As Long
Dim bolStart As Boolean

lngCountDown = intCountBlanks
intCountBlanks = intCountBlanks + 1
For lngRow = 2 To 2000000000
    If IsEmpty(Cells(lngRow, 1).Value2) Then Exit For
    For lngColumn = 2 To 100
        If IsEmpty(Cells(1, lngColumn).Value2) Then Exit For
        If lngRow = Range(strLastRange).Row And lngColumn = Range(strLastRange).Column Then bolStart = True
        If bolStart = True Then
            If IsEmpty(Cells(lngRow, lngColumn).Value2) Then
                Cells(lngRow, lngColumn).Formula = "=" & strLastCell & "-((" & strLastRange & "-" & strToRange & ")/" & intCountBlanks & ")"
                Cells(lngRow, lngColumn).Interior.ColorIndex = 36
                lngCountDown = lngCountDown - 1
            End If
            strLastCell = Cells(lngRow, lngColumn).Address
        End If
        If lngCountDown = 0 Then Exit Sub
    Next lngColumn
Next lngRow

End Sub

---

你想以线性方式填充它是什么意思？例如，在示例中，您希望1月3日的两个相邻值的平均值是多少，即4.23%+3.21%/2=3.72%？还是行的第一个和最后一个值的函数？我只是浏览了一下代码，因为它似乎不仅仅是填空。