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

时间:2017-10-11 16:54:52

标签: excel vba

我正在寻找一个宏,它将根据列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

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

1 个答案:

答案 0 :(得分:0)

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

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作为它的值。