Question

我需要标记表格的某些区域。我需要从“Run Start”到“Run End”的所有内容，以便在不同的列中包含相应的运行编号。

H (Run #)    O (Activity_code)                    S (what I need)
  1          Piping                               
  1          Run Start - TBRT                     1
  1          OPS-RIH/POOH/Trip/Wiper Trip         1
  1          OPS-Drilling                         1
  1          OPS-Surveying                        1
  1          RIG-OPS-RIH/POOH/Trip/Wiper Trip     1
  1          Run End - TART                       1
  1          OPS BHA Config
  1          Piping 
  2          Run Start - TBRT                     2

我还没有完全弄清楚VBA中的循环。这就是我想出来的。我似乎无法找到任何东西或让它工作。任何帮助将不胜感激。

For i = 2 To Worksheet1.UsedRange.Rows.Count
    If Worksheet1.Cells(i, o) = "Run S*" Then
        x = i
        If Worksheet.Cells(i, o).Value = "Run E*" Then
        Range("S" & x & ":" & "S" & i) = Range("H" & i).Value
        End If
    End If
Exit For
Next

Answer 1

如果您的列中始终有“运行开始”和“运行结束”来定义标签，您可以使用这样的解决方案（我假设三列是“A”，“B”和“C” “）：

Dim count As Integer: count = 2 'check the cell until it's empty
Dim isrunning As Boolean: isrunning = False 'controls if the run has started but not ended
Do While Range("B" & count) <> ""
    If isrunning = True Then
        Range("C" & count) = Range("A" & count)
        If Left(Range("B" & count),5) = "Run E" Then isrunning = False                
    Else
        If Left(Range("B" & count),5) = "Run S" Then
            Range("C" & count) = Range("A" & count)
            isrunning = True
        End If
    End If
    count = count + 1
Loop

请注意：

当“B”列中的单元格变空时，这将停止;
如果您在“运行开始”和“运行结束”（包括）之间，我看到您要将“A”列中的数字报告到“C”列，但如果我错了，请更正我。

Answer 2

你可以试试这个：

Sub ject()
    Const what1 As String = "Run Start - TBRT"
    Const what2 As String = "Run End - TART"
    Application.ScreenUpdating = False
    With Sheets("Sheet1") '~~> change to suit
         Dim r As Range, lr As Long
         lr = .Range("A" & .Rows.Count).End(xlUp).Row
         Set r = .Range("A1", "C" & lr) '~~> assumes data is in A - C column
         Dim run, runs
         runs = GetFilters(r.Offset(1, 0).Resize(r.Rows.Count - 1, 1))
         For Each run In runs
            Dim str As Range, enr As Range
            r.AutoFilter 1, run
            Set str = r.Find(what1): Set enr = r.Find(what2)
            If Not str Is Nothing And Not enr Is Nothing Then _
                .Range(str, enr).Offset(0, 1).Value = run
         Next
         .AutoFilterMode = False
    End With
    Application.ScreenUpdating = True
End Sub

Private Function GetFilters(source As Range)
    Dim c As Range
    If Not source Is Nothing Then
        With CreateObject("Scripting.Dictionary")
            For Each c In source.SpecialCells(xlCellTypeVisible).Cells
                If Not .Exists(c.Value) Then .Add c.Value, c.Value
            Next
            GetFilters = .Keys
        End With
    End If
End Function

这会忽略 RUNS 而没有结束。如果您需要考虑，可以更改 If语句为其添加更多条件。 HTH。

使用2个变量标记区域

2 个答案: