使用2個變量標記區域

Question

我需要標記表格的某些區域。我需要從「運行開始」到「運行結束」的所有內容在不同列中具有相應的運行編號。

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 

請注意：

1. 當在列的單元格這將阻止 」B「 變成空;
2. 如果您在運行開始和運行結束（包含）之間，我看到您想要將列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 

這忽略遊程沒有結束呢。如果您想要考慮，可以更改如果聲明向其添加更多條件。 HTH。