1

Topic: Changeover Hyperlinks. Add Anchor

Whether there is in VBA such command/method which operated similarly Hyperlinks. Add Anchor, but worked with variables, instead of with ranges?

book1.ActiveSheet. Hyperlinks. Add Anchor: = Cells (34 + (x - 1), (26 + (iLoop * 21)) + (y - 1)), Address: = data (x, y), TextToDisplay: = vata (x, y)

What instead of

Cells (34 + (x - 1), (26 + (iLoop * 21)) + (y - 1))

there was a variable
To my question all code is not necessary, but all the same I will attach (it works well)
[spoiler]

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) = "List1"
sheetNames (2) = "List2"
sheetNames (3) = "List3"
sheetNames (4) = "List4"
sheetNames (5) = "List5"
sheetNames (6) = "List6"
sheetNames (7) = "List7"
sheetNames (8) = "List8"
sheetNames (9) = "List9"
sheetNames (10) = "List10"
sheetNames (11) = "List11"
sheetNames (12) = "List12"
sheetNames (13) = "List13"
sheetNames (14) = "List14"
sheetNames (15) = "List15"
sheetNames (16) = "List16"
sheetNames (17) = "List17"
sheetNames (18) = "List18"
sheetNames (19) = "List19"
Set book1 = Workbooks. Open ("E:\Super M\ \ \ 7 / auxiliary \ Softello / variables \6.xlsm")
iLoop =-1
With book1.Worksheets ("List1").Range ("R34:R99")
For Each r In.Rows
If r. Value = 1 Then
iLoop = iLoop + 1
Ssilka = r. Offset (-13).Hyperlinks. Item (1).Address
.Parent. Parent. Worksheets (sheetNames (1)).Activate
.Parent. Parent. Save
extractTable Ssilka, book1, iLoop
End If
Next r
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 vata ()
Dim tata ()
Dim oHttp As Object
Dim oRegEx As Object
Dim sResponse As String
Dim oRange As Range
Dim Perem1 As String
Dim Perem2 As String
' 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)
ReDim vata (1 To iRows - 1, 1 To iCols - 1)
ReDim tata (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")
data (x, y) = Replace (data (x, y), "about:", "http://allscores.ru/soccer/")
vata (x, y) = oRow. Cells (y).innerText
book1.ActiveSheet. Hyperlinks. Add Anchor: = Cells (34 + (x - 1), (26 + (iLoop * 21)) + (y - 1)), Address: = data (x, y), TextToDisplay: = vata (x, y)
End If
Next y
Next x
Set oRow = Nothing
Set oTable = Nothing
Set oDom = Nothing
End Function

[/spoiler]

2

Re: Changeover Hyperlinks. Add Anchor

maxim863;

dim myCell as range
'...
set myCell = Cells (34 + (x - 1), (26 + (iLoop * 21)) + (y - 1))
book1.ActiveSheet. Hyperlinks. Add Anchor: = myCell...

3

Re: Changeover Hyperlinks. Add Anchor

The Kazan;
Yes, but I not want to achieve it, so such variant does not approach

4

Re: Changeover Hyperlinks. Add Anchor

maxim863, so it is not clear, that you want. Can, it?

Dim myCell As Range, myCell1 As Range
'...
Set myCell1 = Cells (a, b) ' a, b - certain initial coordinates, calculate
For x = 1 To iRows - 1
Set oRow = oTable. Rows (x)
Set myCell1 = myCell1.Offset (1) ' offset on 1 downwards
Set myCell = myCell1 ' a variable for an internal cycle
For y = 1 To iCols - 1
'...
Set myCell = myCell. Offset (1) ' offset on 1 to the right
myCell. Select ' use for debugging at step by step pass, then delete
book1.ActiveSheet. Hyperlinks. Add Anchor: = myCell '...

5

Re: Changeover Hyperlinks. Add Anchor

The Kazan;
I have 2 dynamic arrays, want to create 3rd dynes th an array (connecting 2 first arrays in style of a method (Hyperlinks. Add Anchor)) and then to interpose 3rd array entirely and at once in Excel (generally my overall objective to accelerate operation of my initial program)

6

Re: Changeover Hyperlinks. Add Anchor

maxim863 wrote:

I want to create 3rd dynes th an array (connecting 2 first arrays in style of a method (Hyperlinks. Add Anchor)) and then to interpose 3rd array entirely and at once in Excel

it does not turn out. Hyperlinks in a range do not form an array, as.Value or.Formula.

maxim863 wrote:

generally my overall objective to accelerate operation of my initial program

Try to add to a cycle

Application. ScreenUpdating = False
Application. EnableEvents = False

, after a cycle return =True.

7

Re: Changeover Hyperlinks. Add Anchor

The Kazan;
Invented, as on another to solve the task