3つのハイパーリンクを検索し、それぞれを新しいシートに出力する

Question

ハイパーリンクを抽出するColumn "U"ユニット（1）とそのセルの反対側の列 "E"を見て、それを新しいシートに貼り付けますユニット）

私はプログラムを作成しましたが、必要な結果は得られません。

私はあなたの過ちをしていると思う

Sub подготовительная() 

    Dim r As Range 
    Dim rng As Range 
    Dim book1 As Workbook 
    Dim str As String 
    Dim gbr As Range 

    Set book1 = Workbooks.Open("E:\...\Вопрос.xlsx") 
    'переходим в активную книгу на 1-ую страницу и выделяем диапозон 
    book1.Worksheets("7").Activate 

    Set rng = book1.Worksheets("7").Range("U33:U99") 
    'находим первую 1 
    Set r = rng.Find(What:="1") 

    'запоминаем 1-ый адресс 
    firstAddress = r.Address 
    'другая переменная 
    Set gbr = r.Offset(, -16) 

    'забираем гиперссылку 
    str = gbr.Hyperlinks.Item(1).Address 
    'вставляем в Лист1 
    book1.Worksheets("Лист1").Cells(1, 1).Value = str 

    'ищем вторую 1 
    book1.Worksheets("7").Activate 
    Set r = r.FindNext(r) 
    If r.Address <> firstAddress Then 
     Set gbr = r.Offset(, -16) 
     str = gbr.Hyperlinks.Item(1).Address 
     book1.Worksheets("Лист2").Cells(1, 1).Value = str 
    Else: Exit Sub 
    End If 

    'ищем третью 1 
    book1.Worksheets("7").Activate 
    Set r = r.FindNext(r) 
    If r.Address <> firstAddress Then 
     Set gbr = r.Offset(, -16) 
     str = gbr.Hyperlinks.Item(1).Address 
     book1.Worksheets("Лист3").Cells(1, 1).Value = str   
    Else: Exit Sub 
    End If 

    End Sub 

Answer 1

：

あなたの代わりに rng

の範囲rで「1」がそうあなたが

を使用する必要がある場合には、次の発生を見つけるためにしようとしている

Set r = r.FindNext(r) 

Set r = rng.FindNext(r) 

さらにコードdループ、文字列配列を使用した独自の（あなたの3枚の名を格納する場所：「Лист1」、「Лист2」と「Лист3」）といくつかのWith文を、次のように：

Option Explicit 

Sub main() 
    Dim r As Range 
    Dim firstAddress As String 
    Dim iLoop As Long 
    Dim sheetNames(1 To 3) As String 

    sheetNames(1) = "Лист1" '<--| change it with your actual 1st sheet name 
    sheetNames(2) = "Лист2" '<--| change it with your actual 2nd sheet name 
    sheetNames(3) = "Лист3" '<--| change it with your actual 3rd sheet name 
    With Workbooks.Open(E:\...\Вопрос.xlsx").Worksheets("7").Range("U33:U99") '<--| open wanted workbook and refer to cells "U33:U99" in its worksheet "7" 
     Set r = .Find(What:="1") '<--| the Find() method is called on the range referred to in the preceding With statement 
     If Not r Is Nothing Then 
      firstAddress = r.Address 
      Do 
       iLoop = iLoop + 1 '<-- update loop counter 
       .Parent.Parent.Worksheets(sheetNames(iLoop)).Cells(1, 1).value = r.Offset(, -16).Hyperlinks.item(1).Address '<--| write into proper worksheet whose name is taken from sheetNames array at index corresponding to current loop 
       Set r = .FindNext(r) '<--| the FindNext() method is still called on the same range as in the preceding .Find() statement 
      Loop While Not r Is Nothing And r.Address <> firstAddress And iLoop < 3 '<--| exit loop if either you hit the first link or completed three loops 
     End If 
    End With 
End Sub