VBA Open workbook from current cells value

Question

Привет У меня есть таблица, которую я хочу использовать текущие значения ячеек, чтобы открыть указанный URL и ввести в колонку рядом с ней. URL содержит только один набор символов. Я попытался запись с относительными ссылки включены и получил следующее:

Sub GETASINV2() 
' 
' GETASINV2 Macro 
' 

' 
    Selection.Copy 
    Application.CutCopyMode = False 
    Workbooks.OpenText Filename:="http://upctoasin.com/027616716927", Origin:= _ 
     xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _ 
     , ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= _ 
     False, Space:=False, Other:=False, FieldInfo:=Array(1, 1), _ 
     TrailingMinusNumbers:=True 
    Selection.Copy 
    ActiveWindow.ActivateNext 
    ActiveCell.Offset(0, 1).Range("A1").Select 
    ActiveSheet.Paste 
    ActiveCell.Offset(1, -1).Range("A1").Select 
End Sub 

Как вы можете видеть все это, кажется, по отношению друга от имени файла, где она подобрала значение я вошел и не факт, что я " copy вставил значение ".

Как только это будет сделано, я хочу повторить оставшийся список URL-адресов (около 3000). Вероятно, я могу найти какое-то время повторения до тех пор, пока не появится больше URL-адресов, но если вы знаете, какой способ будет рад получить помощь и в этой части!

Спасибо

Answer 1

Я поставил ссылку, которую вы дали нам в строках A1:A10 и побежал следующий код, чтобы получить петлю через каждую ячейку и поместить значение из ссылки в ячейке это правильно.

Я также проверил его с 1000 ссылками, и он завершился за 279 секунд - примерно 4 раза в секунду. Мне было бы интересно узнать, есть ли у кого-нибудь более быстрый метод.

Sub GETASINV2() 
    Application.ScreenUpdating = False 

    Dim sht As Worksheet 
    Set sht = ThisWorkbook.Worksheets("Sheet1") 'update for your worksheet name 

    Dim inputRange As Range, r As Range 
    Set inputRange = sht.Range("A1:A10") 'update for your range 

    For Each r In inputRange 
     With sht.QueryTables.Add(Connection:= _ 
      "URL;" & r.Value, Destination:=r.Offset(0, 1)) 
      .Refresh BackgroundQuery:=False 
      .Delete 
     End With 
    Next r 

    Application.ScreenUpdating = True 
End Sub 

---

Update

Есть ли способ его разработку размера самого диапазона на основе количества записей без зазора?

Да, вы можете заменить это:

Set inputRange = sht.Range("A1:A10") 

С следующее:

Set inputRange = Range(sht.Range("A1"), sht.Range("A1").End(xlDown)) 

Где A1 является расположение вашего первого звена