根据单元格时间值复制和插入行答案

【问题标题】：Copy and Insert Row Based on Cell Time Value根据单元格时间值复制和插入行
【发布时间】：2015-07-13 04:40:16
【问题描述】：

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

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 的人编写的，包括他的一些 cmets：

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

任何帮助将不胜感激。

【问题讨论】：

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

标签： excel vba

【解决方案1】：

改用这个：

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

【讨论】：