Question

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

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

Here is a similar question from a previous user

非常感谢任何帮助。

Answer 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

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

1 个答案: