替换文本（用超链接替换href）

Question

有一个程序工作正常。她的工作结果是元素表（href）的Excel中的输出（每个元素看起来像：about：new_ftour.php？champ = 2604 & f_team = 412 & tour = 110）。我想用超链接替换href（将“about：”替换为“http://allscores.ru/soccer/”）。在一行（oRange.Value = data）之后，我添加了一行（oRange.Replace What：=“about：”，Replacement：=“http://allscores.ru/soccer/”）。但出于神秘的原因，程序会给出一个错误（运行时错误'91'）。在线（Loop While Not r Is Nothing and r.Address <> firstAddress And iLoop < 19）。

Sub Softгиперссылки() 
     Application.DisplayAlerts = False 


    Call mainмассивы 

     Application.DisplayAlerts = True 
    End Sub 


    Sub mainмассивы() 
    Dim r As Range 
    Dim firstAddress As String 
    Dim iLoop As Long 
    Dim book1 As Workbook 
    Dim sheetNames(1 To 19) As String 
    Dim Ssilka As String 


    sheetNames(1) = "Лист1" 
    sheetNames(2) = "Лист2" 
    sheetNames(3) = "Лист3" 
    sheetNames(4) = "Лист4" 
    sheetNames(5) = "Лист5" 
    sheetNames(6) = "Лист6" 
    sheetNames(7) = "Лист7" 
    sheetNames(8) = "Лист8" 
    sheetNames(9) = "Лист9" 
    sheetNames(10) = "Лист10" 
    sheetNames(11) = "Лист11" 
    sheetNames(12) = "Лист12" 
    sheetNames(13) = "Лист13" 
    sheetNames(14) = "Лист14" 
    sheetNames(15) = "Лист15" 
    sheetNames(16) = "Лист16" 
    sheetNames(17) = "Лист17" 
    sheetNames(18) = "Лист18" 
    sheetNames(19) = "Лист19" 

    'пропускаем ошибку 

    Set book1 = Workbooks.Open("E:\Super M\Проект ставки\Поиск решения\Усов 7\Условия для андердогов\пробная.xlsm") 


    iLoop = 0 

    With book1.Worksheets("Лист1").Range("S34:S99") '<--| open wanted workbook and refer to cells "U33:U99" in its worksheet "7" 

    Set r = .Find(What:="1", LookIn:=xlValues) '<--| 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 
      Ssilka = r.Offset(, -14).Hyperlinks.Item(1).Address 
      .Parent.Parent.Worksheets(sheetNames(1)).Activate 
      .Parent.Parent.Save 
      extractTable Ssilka, book1, iLoop 

      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 < 19 '<--| exit loop if either you hit the first link or completed three loops 
    End If 
    End With 
    book1.Save 
    book1.Close 



    Exit Sub 


    End Sub 


    Function extractTable(Ssilka As String, book1 As Workbook, iLoop As Long) 
    Dim oDom As Object, oTable As Object, oRow As Object 
    Dim iRows As Integer, iCols As Integer 
    Dim x As Integer, y As Integer 
    Dim data() 
    Dim oHttp As Object 
    Dim oRegEx As Object 
    Dim sResponse As String 
    Dim oRange As Range 



    ' get page 
    Set oHttp = CreateObject("MSXML2.XMLHTTP") 
    oHttp.Open "GET", Ssilka, False 
    oHttp.Send 

    ' cleanup response 
    sResponse = StrConv(oHttp.responseBody, vbUnicode) 
    Set oHttp = Nothing 

    sResponse = Mid$(sResponse, InStr(1, sResponse, "<!DOCTYPE ")) 

    Set oRegEx = CreateObject("vbscript.regexp") 
    With oRegEx 
    .MultiLine = True 
    .Global = True 
    .IgnoreCase = False 
    .Pattern = "<(script|SCRIPT)[\w\W]+?</\1>" 
    sResponse = .Replace(sResponse, "") 
    End With 
    Set oRegEx = Nothing 

    ' create Document from response 
    Set oDom = CreateObject("htmlFile") 
    oDom.Write sResponse 
    DoEvents 

    ' table with results, indexes starts with zero 
    Set oTable = oDom.getelementsbytagname("table")(3) 

    DoEvents 

    iRows = oTable.Rows.Length 
    iCols = oTable.Rows(1).Cells.Length 

    ' first row and first column contain no intresting data 
    ReDim data(1 To iRows - 1, 1 To iCols - 1) 

    ' fill in data array 
    For x = 1 To iRows - 1 
    Set oRow = oTable.Rows(x) 

    For y = 1 To iCols - 1 
     If oRow.Cells(y).Children.Length > 0 Then 
      data(x, y) = oRow.Cells(y).getelementsbytagname("a")(0).getattribute("href") 

      '.Replace(data(x, y), "about:", "http://allscores.ru/soccer/") 

     End If 

     Next y 
    Next x 

    Set oRow = Nothing 
    Set oTable = Nothing 
    Set oDom = Nothing 


    ' put data array on worksheet 

    Set oRange = book1.ActiveSheet.Cells(34, iLoop * 25).Resize(iRows - 1, iCols - 1) 
    oRange.NumberFormat = "@" 
    oRange.Value = data 

    oRange.Replace What:="about:", Replacement:="http://allscores.ru/soccer/" 


    Set oRange = Nothing 

    'Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _ 
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _ 
     ReplaceFormat:=False, MatchByte:=False 


    '<DEBUG> 
    ' For x = LBound(data) To UBound(data) 
    '  Debug.Print x & ":[ "; 
    '  For y = LBound(data, 2) To UBound(data, 2) 
    '   Debug.Print y & ":[" & data(x, y) & "] "; 
    '  Next y 
    '  Debug.Print "]" 
    ' Next x 
    '</DEBUG> 



    End Function 

Answer 1

正如@ YowE3K在评论中提到的，如果r is Nothing，VBA引擎将继续评估IF语句，并会失败的r.Address。

其他语言不同的行为，并为他们找到一个假条件将尽快逃避检查，但VBA不会做这种方式 - 这就是所谓的短路评价 - Does the VBA "And" operator evaluate the second argument when the first is false?

这是一个办法解决：

Option Explicit 

Public Sub TestMe() 

    Dim iloop   As Long 
    Dim r    As Range 
    Dim firstAddress As String 

    Do While True 

     If r Is Nothing Then Exit Do 
     If r.Address = firstAddress Then Exit Do 
     If iloop < 10 Then Exit Do 

     'Do the action 

    Loop 

End Sub