|
|
这是我下载老钱庄网站上连续增仓数据时编的一小段代码，效果还不错，不知能否供你借鉴：主要是网址要改为你自己的。total_page为表格的总页码，Str((nn - 1) * 32 + 1)中32表示每页有32行， .WebTables = "4"表示网页中的第4张表格。 关键在于.Name = "204.aspx?parameter=zcgg&type=0&page=nn"是有规律的。若无规律，我也没啥好办法
Sub 机构连续增仓()
'
' 宏1 Macro
' caiwu1 记录的宏 2009-1-18
'
'老钱庄连续增仓
total_page = Cells(10, 3).Value
Sheets("连续机构增持").Select
Application.ScreenUpdating = False
Dim nn As Integer
Dim nPage As Integer
Dim maxRow As Integer
maxRow = Range("A" & Rows.Count).End(xlUp).Row
If maxRow > 0 Then
crange1 = "A1:J" & maxRow: Range(crange1).Clear
End If
nn = 1
For nn = 1 To total_page
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://www.538538.com/stock_2/60 ... mp;type=0&page=" & Trim(Str(nn)), Destination:=Range("A" & Trim(Str((nn - 1) * 32 + 1))))
.Name = "204.aspx?parameter=zcgg&type=0&page=nn"
.FieldNames = True
.RowNumbers = False
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "4"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.Refresh BackgroundQuery:=False
End With
Next
'删除“排名”等表头和空行
nRow = Range("A" & Rows.Count).End(xlUp).Row
crange = "A2:A" & nRow
Range(crange).Select
Selection.Replace What:="股票代码", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
Range("A1").Select
Application.ScreenUpdating = True
End Sub |
|
/1 
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2010-12-29 11:29
楼主
