获得两个字符串之间的内容在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