Question

我正在寻找一个宏，它将根据列E中的单元格值插入行。如果上下单元格的差异大于0.002，我希望在它们之间插入两行。下面是我希望数据看起来像

的示例

EX。

E栏

42948.745

（插入空白（行）

（插入空行）

42948.758

（插入空白（行）

（插入空行）

42948.898

42948.900

42948.901

（插入空白（行）

（插入空行）

42948.933

如果代码包含一种方法来填充空白行中的单元格，上面的单元格为+ 0.001，底部单元格为-0.001，则更好。实施例

42948.901

插入42948.902

插入42948.932

42948.933

非常感谢，因为我一直在努力解决这个问题。我有很多捷径，但没有解决方案。

Answer 1

以下代码将执行您想要的操作

Sub InsertBlankRowAndSetValue()
    Dim yourColumn As String
    Dim rowToStart As Integer
    Dim nameOfYourSheet As String

    Dim currentValue As Double
    Dim previousValue As Double

    'EDIT VALUES HERE
    yourColumn = "E"
    rowToStart = 1
    nameOfYourSheet = "Name of your sheet"

    With ThisWorkbook.Sheets(nameOfYourSheet)
        'For each cell in the column from the end
        For i = .Cells(.Rows.Count, yourColumn).End(xlUp).Row To rowToStart + 1 Step -1
            currentValue = CDbl(.Range(yourColumn & i).Value)
            previousValue = CDbl(.Range(yourColumn & i).Offset(-1, 0).Value)

            'If the difference with the previous > 0.002
            If ((currentValue - previousValue) > 0.002) Then
                'Add rows and set values
                .Rows(i).EntireRow.Insert Shift:=xlDown
                .Range(yourColumn & i).Value = currentValue + 0.001
                .Rows(i).EntireRow.Insert Shift:=xlDown
                .Range(yourColumn & i).Value = previousValue + 0.001
            End If
        Next i
    End With
End Sub

说明

在nameOfYourSheet = "Name of your sheet"中修改工作表的名称，使其正常工作。

我从底部开始遍历列中的每个值（当你在上面添加一行时索引的问题少了），如果差值超过0.002，那么我添加一行并将+0.001作为它的值。

根据值在两个单元格之间插入行

1 个答案:

说明