Копировать диапазон между одинаковыми критериями VBA

Question

Мне нужно скопировать диапазон между одной и той же строкой, скажем, мне нужно скопировать все между двумя вариантами копирования:

Copy abcd abcd abcd abcd abcd abcd copy

Результат:

abcd abcd abcd abcd abcd abcd

I 'я искал везде и не мог найти ответ.

Мне удалось найти последнее вхождение нужной строки, но я не могу понять, как скопировать диапазон строк между теми же двумя строками, вот здесь »Что я получил до сих пор

Public Sub buscaIntervalo()
    Dim sPalavra As String
    Dim rngTermo As Range
    sPalavra = "Grupo: 1 - Ativos" 'criteria string

    Set rngTermo = Range("C1:C999").Find(what:=sPalavra, After:=Range("C1"), searchorder:=xlByColumns, searchdirection:=xlPrevious)
MsgBox (rngTermo.Address) 'returns it´s last occurrence
End Sub

Answer 1

_{Я искал везде и не мог найти ответ.}

dim str as string, d as string
str = "abc copy ABCD EFGH IJKL MNOP QRST UVWX YZ copy def"
d = "copy"

Используйте вложенные функции InStr для определения местоположения начальной и конечной точек.

str = mid$(str, instr(1, str, d, vbtextcompare)+len(d)))
str = trim$(left$(str , instr(1, str, d, vbtextcompare) - 1))
debug.print str

Используйте copy в качестве разделителя для разделения.

str = trim$(split(split(str, d)(1), d)(0))
'*copy* is used for both start and stop; the above could be
str = trim$(split(str, d)(1))
debug.print str

Используйте регулярные выражения для извлечения подстроки.

dim rgx as object
set rgx = createobject("vbscript.regexp")
with rgx
    .global = False
    .ignorecase = True
    .multiline = False
    .pattern = d & " (.*?)(?= " & d & ")"
    if .test(str) then
        str = mid$(.execute(str)(0), 6)
        debug.print str
    End If
end with

Использованиефункции листа для анализа подстроки.

with application.worksheetfunction
    str = .replace(str, 1, .search(d, str) + len(d), vbnullstring)
    str = trim(.replace(str, .search(d, str), len(str), vbnullstring))
    debug.print str
end with

'alternate
with application.worksheetfunction
    str = trim(mid$(.substitute(str, d, space(len(str))), len(str), len(str)))
    debug.print str
end with

Так что, похоже, вы действительно не так уж и тяжело выглядели.

Answer 2

Я сам придумал решение, надеюсь, это поможет кому-то еще.Этот код находит последнее появление строки, получает ее адрес, затем из этой конкретной ячейки копирует выбранный диапазон снизу вверх.Спасибо за тех, кто пытался помочь:)

Option Explicit

Public Sub buscaIntervaloDinamico () Dim sPalavra As String Dim rngTermo As Range

sPalavra = "Grupo: 1 - Ativos"

Set rngTermo = Range("C1:E999").Find(what:=sPalavra, After:=Range("C1"), _
searchorder:=xlByColumns, searchdirection:=xlPrevious)

rngTermo = rngTermo.Address
rngTermo = Range(ActiveCell, ActiveCell.EntireColumn.Cells(5, -1)).Copy

End Sub

Answer 3

Эта ссылка может вам помочь: https://www.access -programmers.co.uk / forums / showthread.php? T = 181399

Здесь, Atomic Shrimp 16 октября 2009 года писал:

Допустим, у нас есть строка с именем strInput, содержащая:
123456789 # банан # 987654

InStr (strInput, "#") возвращает 10, поэтому мы знаем позициюпервый экземпляр #

InStrRev (strInput, "#") возвращает 17, поэтому мы знаем позицию последнего экземпляра #

Итак, InStrRev (strInput, "#") - InStr(strInput, "#") дает вам (более или менее) длину бита, который вы хотите извлечь

Mid (strinput, InStr (strinput, "#"), InStrRev (strinput, "#"))- InStr (strinput, "#")) возвращает '#banana' - поэтому нам нужно начинать с одной позиции далее:

Mid (strinput, InStr (strinput, "#") + 1, InStrRev (strinput, "#") - InStr (strinput, "#")) возвращает 'banana #' - поэтому нам нужно сделать извлеченную часть на один символ короче:

Mid (strinput, InStr (strinput, "#") +1, InStrRev (strinput," #") - InStr (strinput," # ") - 1), кажется, работает ...

Однако, если вы передадите его: 123456789 # банан # 0000 # яблоко # 987654, он вернет 'банан # 0000#apple ', и если вы передадите ей строку, содержащую менее двух символов, она упадет ...