Question

我对VBA相当新（我写了两个小脚本），请原谅我是新手。我现在已经用自己的时间尝试了这个，并且好像是在圈子里。任何指导或方向将不胜感激。

在G列（最右边）按升序排列，如果两个或多个连续的空白行后面跟着1分钟或更短的任何名称，则复制该名称并将其粘贴到表2中。对于下面的数据，Mike和Scott会被复制到第二页。

13-11-04 6:36   10937   Service Identify Fail       0   
13-11-04 6:36   10937   Service Identify Fail       0   
13-11-04 6:37   10937   Service Identify Fail       0   
13-11-04 6:37   10937   Service Identify Success    In  28  Mike
13-11-04 6:59   10920   Reception Identify Success  In  280 Mandy
13-11-04 6:59   10937   Service Identify Success    In  210 Brian
13-11-04 7:03   10937   Service Identify Fail       0   
13-11-04 7:03   10937   Service Identify Fail       0   
13-11-04 7:03   10937   Service Identify Success    In  114 Scott

Answer 1

我唯一不确定的是如何检查它是否在一分钟之内，但这是我到目前为止的代码。

Private Sub printName()
    Dim nameRange, c3ll As Range
    Dim ws1, ws2 As Worksheet

    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    lastr0w = ws1.Cells(Rows.Count, 7).End(xlUp).Row
    Set nameRange = ws1.Range("G1:G" & lastr0w)

    For Each c3ll In nameRange
        'can't be the 1st two cells since there needs to be 2 or more consecutive black rows previous to selected cell
        If c3ll.Row > 2 And c3ll.Value <> Empty Then
            prev1 = ws1.Cells(c3ll.Row - 1, 7).Value
            prev2 = ws1.Cells(c3ll.Row - 2, 7).Value
            If IsEmpty(prev1) And IsEmpty(prev2) Then
                ws2.Range("A1").EntireRow.Insert
                For i = 2 To 7
                    ws2.Cells(1, i) = ws1.Cells(c3ll.Row, i)
                Next i
            End If
        End If
    Next c3ll
End Sub

PS我也是VBA的新手，但我正在使用这些问题来学习和自学代码。

在G列中，如果两个连续的空白行后跟一个带字符的单元格，请将该组字符粘贴到工作表2中

1 个答案: