Возвращаемые строки Значения между 2 строками с определенным предложением через FIND - PullRequest
Новая
       10

Возвращаемые строки Значения между 2 строками с определенным предложением через FIND

0 голосов
/ 15 ноября 2018

У меня есть это в листе 1, столбец A, с большим количеством другого текста до и после:

enter image description here

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

Sponsor de l'Indice Marché Site Internet

и с: 

DEFINITIONS APPLICABLES AUX(EVENTUELS), AU

В листе B8:

enter image description here

Это мой псевдокод (не работает на VBA): 

Dim x As Long
    x = 1
    Do While Worksheets("Adobe Reader").Range("A1:A500").Find("Sponsor de l'Indice March? Site Internet").Row != Worksheets("Sheet1").Range("A1:A500").Find("DEFINITIONS APPLICABLES AUX(EVENTUELS), AU").Row
Set SJ = Worksheets("Sheet1").Range("A1:A500").Find("Nom de l'Indice Code Bloomberg Sponsor de l'Indice March? Site Internet")
ActiveCell.Offset(1, 0).Select
ActiveCell.Offset(1, 0).Copy
Worksheets("Sheet2").Range("B8").Offset(ColumnOffset:=x - 1).Paste

1 Ответ

0 голосов
/ 15 ноября 2018

Вы можете попробовать это: 

Option Explicit

Sub copyRangeBetweenLookUpValues()

    Dim lookUpValue1 As String
    Dim lookUpValue2 As String

    Dim lookUpValue1R As Long, lookUpValue1C As Long, lookUpValue2R As Long, lookUpValue2C As Long

    'set your lookup values here
    lookUpValue1 = "Sponsor de l'Indice Marché Site Internet"
    lookUpValue2 = "DEFINITIONS APPLICABLES AUX(EVENTUELS), AU"

    'find row and column of first value
    lookUpValue1R = Cells.Find(lookUpValue1).Row
    lookUpValue1C = Cells.Find(lookUpValue1).Column

    'find row and column of second value
    lookUpValue2R = Cells.Find(lookUpValue2).Row
    lookUpValue2C = Cells.Find(lookUpValue2).Column

    'copy range between these 2 values (but without values so first Row+1, second Row -1)
    Range(Cells(lookUpValue1R + 1, lookUpValue1C), Cells(lookUpValue2R - 1, lookUpValue2C)).Copy

    'paste 
    Range("B1").PasteSpecial xlPasteAll

End Sub
...