VBA: анализ гиперссылки на основе диапазона столбцов - PullRequest
0 голосов
/ 06 марта 2019

У меня ниже скрипт для копирования и фильтрации на основе массива. В диапазоне B: B у меня есть ссылка, которую я хочу проанализировать в другом диапазоне столбца, скажем, в столбце BM: BM, но я не уверен, что его можно включить в первый скрипт

Function GetURL(Rng As Range) As String
    On Error Resume Next
    GetURL = Rng.Hyperlinks(1).Address
End Function

Sub AnotherTry2()
    Dim wbSource As Workbook, wbDest As Workbook
    Dim wsSource As Worksheet, wsDest As Worksheet
    Dim rngSource As Range, rngDest As Range
    Dim critSite As ListObject
    Dim myArray As Variant
    Dim TempArray As Variant

    Set wbSite = ThisWorkbook
    Set wsSite = wbSite.Worksheets("newlist")
    Set critSite = wsSite.ListObjects("Table6")

    TempArray = critSite.DataBodyRange
    myArray = Application.Transpose(TempArray)

    Set wbSource = Workbooks.Open("c:\temp\Data.xlsx", , True)
    Set wsSource = wbSource.Worksheets("Report 1")
    wsSource.Range("A:BL").AutoFilter field:=50, Criteria1:=myArray, Operator:=xlFilterValues

    Set wbDest = ThisWorkbook
    Set wsDest = wbDest.Worksheets("raw")

    wsDest.Application.CutCopyMode = False
    wsSource.Range("A1:BL200000").SpecialCells(xlCellTypeVisible).Copy
    wsDest.Cells(1, 1).PasteSpecial
    wbDest.Save 
    wbSource.Close (False)
End Sub

1 Ответ

1 голос
/ 06 марта 2019

Вы можете добавить следующий код:

wsDest.Range("BM1:BM200000").Formula = "=HYPERLINK(B1,B1)"

После этой строки:

wsDest.Cells(1, 1).PasteSpecial

Я предлагаю вам выполнить тест с меньшим количеством строк, прежде чем пытаться использовать весь набор данных.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...