獲得兩個字符串之間的內容在VBA Excel中

Question

我寫一個宏，我有以下問題：

我有一個標準化的表 - >請在附

看起來像###之間的數據START和### END可以改變我想寫一個總是在### START和### END的內容之間查找的宏，並將包含操作類型字詞dividend的完整行復制到一個新工作表中。我莫名其妙，因爲我是新進入VBA

是否有人可以幫助

Answer 1

這應該做它不能找到一個解決方案。在標準代碼模塊中放置以下步驟：

Public Sub GetDividends() 
    Dim i&, k&, s$, v, r As Range, ws As Worksheet 
    Set r = [index(a:a,match("###start",a:a,),):index(a:a,match("###end",a:a,),)].Offset(, 6) 
    k = r.Row - 1 
    v = r 
    For i = 1 To UBound(v) 
     If LCase$(v(i, 1)) = "dividend" Then 
      s = s & ", " & i + k & ":" & i + k 
     End If 
    Next 
    s = Mid$(s, 3) 
    If Len(s) Then 
     Set ws = ActiveSheet 
     With Sheets.Add(, ws) 
      ws.Range(s).Copy .[a1] 
     End With 
    End If 
End Sub 

注意：此技術注重效率。它最大限度地減少了VBA和Excel之間的邊界被刺穿的次數。在大型數據集上，這種最佳實踐會使性能發生巨大變化。

Answer 2

如果您的Column Action_Type位於ColumnID 7，則此方法有效。但我認爲源代碼很容易根據您的需要進行更改。

Sub copyRows() 

Dim i As Integer 
Dim ws As Worksheet 


'1 is just the worksheet-ID, you can choose another one via name 
Set ws = ThisWorkbook.Worksheets(1) 


i = 2 
j = 1 


Do While ws.Cells(i, 1) <> "###END" 

'as stated above, 7 refers to the column ID 
If ws.Cells(i, 7) = "Dividend" Then 


'Worksheets(2), see above 

ws.Rows(i).EntireRow.Copy _ 
     Destination:=Worksheets(2).Rows(j) 

j = j + 1 

End If 

i = i + 1 


Loop 

End Sub 

Answer 3

您可以使用find來獲取行位置，然後設置您從那裏的範圍。

Sub Button1_Click() 
    Dim r As Range, fr As String '##START 
    Dim c As Range, fc As String '##END 
    Dim StartR As Integer 
    Dim EndR As Integer 
    Dim NwRng As Range, Nwc As Range 
    Dim nwSh As Worksheet 
    fr = "##Start" 
    fc = "##END" 
    Set r = Range("A:A").Find(what:=fr, lookat:=xlWhole) 
    Set c = Range("A:A").Find(what:=fc, lookat:=xlWhole) 

    If Not r Is Nothing Then 
     StartR = r.Row + 1 
    Else: MsgBox fr & " not found" 
     Exit Sub 
    End If 

    If Not c Is Nothing Then 
     EndR = c.Row - 1 
    Else: MsgBox fc & " not found" 
     Exit Sub 
    End If 

    Set NwRng = Range("G" & StartR & ":G" & EndR) 
    Set nwSh = Sheets.Add 

    For Each Nwc In NwRng.Cells 
     If Nwc = "dividend" Then Nwc.EntireRow.Copy nwSh.Cells(nwSh.Rows.Count, "A").End(xlUp).Offset(1) 
    Next Nwc 

End Sub