在VBA Excel中获取两个字符串之间的内容

Question

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

我有一张标准化的表格 - ＆gt;请查看附件

由于### 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

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