Question

查看列“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

我认为你的错误在于：

Set r = r.FindNext(r)

如果您在r范围内的“1”而非rng

，则尝试查找下一个匹配项

所以你应该使用

Set r = rng.FindNext(r)

此外，您可能希望通过使用循环，字符串数组（存储三个工作表名称的位置：“Лист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

搜索三个超链接并在新工作表上输出每个超链接

1 个答案: