Excel 基于单元格时间值复制和插入行

我的主要问题是，我试图根据另一行的时间值，在另一行的正下方添加一行。下面是我尝试做的一个例子：

column F ========> new column F

2                            1

                             2

2                            1

                             2

1                            1

1                            1

2                            1

                             2

为了更好地解释，如果第一列F中的值为2，则表示大于

0:59:00

的时间值，并在其下方添加另一行。如果它是1，则它表示等于或小于

0:59:00

的时间值，并且不添加任何行

我曾多次尝试编写代码来修复此问题，第一次是由比我更精通VBA的人编写的，其中包括他的一些评论：

Public Sub ExpandRecords()
Dim i As Long, _
    j As Long, _
    LR As Long
'set variable types
LR = Range("A" & Rows.Count).End(xlUp).Row
'setting variable LR as number of rows with data
Application.ScreenUpdating = False
Columns("F:F").NumberFormat = "hh:mm:ss"
'sets number format in column b to text
For i = LR To 1 Step -1
'Executes following code from last row with data to row 1 working backwards
    'If CLng(Left(Range("F" & i).Value, Len(Range("F" & i).Value) - 6)) > 0 Then
    If CLng(Hour(Range("F" & i))) > 0 Then
    'If the hour value in column F is greater than 1, then...
        With Range("F" & i)
        'starting with column F, loop through these statements...
            '.Offset(1, 0).Resize(CLng(Left(Range("F" & i).Value, Len(Range("F" & i).Value) - 6)) - 1, 1).EntireRow.Insert Shift:=xlDown
            .Offset(1, 0).Resize(CLng(Hour(Range("F" & i))).Value, Len(Range("F" & i).Value) - 1, 1).EntireRow.Insert Shift:=xlDown
            'return the value of column F's hour value, change the range to insert the number of rows below based on hour value
            '.Resize(CLng(Left(Range("F" & i).Value, Len(Range("F" & i).Value) - 6)), 1).EntireRow.Value = Range("A" & i).EntireRow.Value
            .Resize(Hour(Range("F" & i)), 1).EntireRow.Value = Range("A" & i).EntireRow.Value
            'Get value of row to be copied
            'For j = 0 To CLng(Left(Range("F" & i).Value, Len(Range("F" & i).Value) - 6))
            For j = 0 To Hour(Range("F" & i))
                Range("H" & i).Offset(j - 1, 0).Value = Application.Text(j, "0")
            Next j
        End With
    Else
        Range("H" & i).Value = Application.Text(1, "0")
    End If
Next i
Application.ScreenUpdating = True
End Sub

任何帮助都将不胜感激

改用这个：

Public Sub ExpandRecords()

    Dim i As Long, s As String
    Const COL = "F"

    For i = 1 To Cells(Rows.Count, COL).End(xlUp).Row
        If Cells(i, COL) = 2 Then s = s & "," & Cells(i, COL).Address
    Next
    If Len(s) Then
        Range(Mid$(s, 2)).EntireRow.Insert
        For i = 1 To Cells(Rows.Count, COL).End(xlUp).Row
            If Cells(i, COL) = vbNullString Then Cells(i, COL) = 1
        Next
    End If

End Sub

---

问题您是否尝试在Excel中记录宏来为您插入行？然后，获取生成的代码并为此重新使用。录制宏并整理它应该不会太困难。我没有尝试录制宏，遗憾的是我对录制宏不太熟悉。你能再解释一下吗？非常感谢。在Excel中，启用开发者工具栏并选择“录制宏”选项。。如果需要，请从Office搜索帮助系统，它非常全面。我的解决方案是否在您的实际工作簿上生成正确的结果？您好，您给我的代码确实完全运行，但我的工作簿中没有任何更改。