获取VBA Excel中两个string之间的内容

我正在写一个macros，我有以下问题：

我有一个标准化的表格 – >请看附件

由于### START和### END之间的数据可以改变，所以我想写一个总是在### START和### END内容之间查找的macros，并复制整个包含操作types的dividend的行成新的表格。 我以某种方式无法find一个解决scheme，因为我是新的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 

注意：这种技术着重于效率。 它最大限度地减less了VBA和Excel之间的边界被刺穿的次数。 在大数据集上，这个最佳实践将会使性能发生巨大的变化。

Answer 2

你可以使用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 

Answer 3

如果你的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