2016-09-11 16 views
0

Web上のテーブルからデータを抽出する予定です。以下のコードは、主にExcelの組み込みWeb廃棄機能からのものです。VBA:最後の行のExcelに印刷

私が欲しいのは、データで最後の行を見つけ、最初の空白の行に印刷することです。

Sub Sub1() 

ActiveSheet.Cells.Clear 

Dim lastRow As Long 
Dim i As Integer 

For i = 1 To 2 

With ActiveSheet.QueryTables.Add(Connection:= _ 
    "URL;http://www.aastocks.com/tc/stocks/quote/symbolsearch.aspx?page=" & i & " &order=symbol&seq=asc", Destination _ 
    :=Range("A,lastRow")) '???? I got an error here, what I want is to detect the last row and print on the first blank row.??? 
    '.CommandType = 0 
    .Name = "symbolsearch_1" 
    .FieldNames = True 
    .RowNumbers = False 
    .FillAdjacentFormulas = False 
    .PreserveFormatting = True 
    .RefreshOnFileOpen = False 
    .BackgroundQuery = True 
    .RefreshStyle = xlInsertDeleteCells 
    .SavePassword = False 
    .SaveData = True 
    .AdjustColumnWidth = True 
    .RefreshPeriod = 0 
    .WebSelectionType = xlSpecifiedTables 
    .WebFormatting = xlWebFormattingNone 
    .WebTables = "10" 
    .WebPreFormattedTextToColumns = True 
    .WebConsecutiveDelimitersAsOne = True 
    .WebSingleBlockTextImport = False 
    .WebDisableDateRecognition = False 
    .WebDisableRedirections = False 
    .Refresh BackgroundQuery:=False 
End With 
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 

Debug.Print lastRow 
Next i 

End Sub 

答えて

0

これは現在問題なく動作しているようです。あなたは近くにいたので、必要に応じて編集できるはずです。

Sub Sub1() 

ActiveSheet.Cells.Clear 

Dim lastRow As Long 
Dim i As Integer 
Dim sTicker As String 

'set the first row to write to 
lastRow = 2 

For i = 1 To 2 
sTicker = InputBox("Enter the code to search for") 
With ActiveSheet.QueryTables.Add(Connection:= _ 
    "URL;http://www.aastocks.com/tc/stocks/quote/symbolsearch.aspx?page=" & sTicker & " &order=symbol&seq=asc", Destination _ 
    :=Range("A" & lastRow)) 'uses the ticker value entered and fixed the destination part 
    '.CommandType = 0 
    .Name = "symbolsearch_1" 
    .FieldNames = True 
    .RowNumbers = False 
    .FillAdjacentFormulas = False 
    .PreserveFormatting = True 
    .RefreshOnFileOpen = False 
    .BackgroundQuery = True 
    .RefreshStyle = xlInsertDeleteCells 
    .SavePassword = False 
    .SaveData = True 
    .AdjustColumnWidth = True 
    .RefreshPeriod = 0 
    .WebSelectionType = xlSpecifiedTables 
    .WebFormatting = xlWebFormattingNone 
    .WebTables = "10" 
    .WebPreFormattedTextToColumns = True 
    .WebConsecutiveDelimitersAsOne = True 
    .WebSingleBlockTextImport = False 
    .WebDisableDateRecognition = False 
    .WebDisableRedirections = False 
    .Refresh BackgroundQuery:=False 
End With 
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 

Next i 

End Sub 
関連する問題