|
本帖最后由 gdqbx 于 2023-1-8 10:28 编辑
程序设想:根据sheet2的股票代码在东财网查询该股票的基本信息并保存在股票基本信息表,运行过程有的股票顺利得到数据,有的却要重复数次才能得到数据。
Sub 宏6()
'
' 宏6 宏
'
' " 源 = Web.Page(Web.Contents(http://f10.eastmoney.com/f10_v2/CompanySurvey.aspx?code=sh600519)),"
' " 源 = Web.Page(Web.Contents(http://f10.eastmoney.com/f10_v2/CompanySurvey.aspx?code=sh600519)),"
myarr = Sheets("sheet2").Range("F3:F20")
For i = 1 To UBound(myarr)
myno = Trim(myarr(i, 1)) '股票代码
myname = myno & "0" '查询名称
AL = myno & "A"
Sheets("股票基本信息").Select
L = Range("B65536").End(xlUp).Row + 1
'Sheets("Table 0").Select
ActiveWorkbook.Queries.Add Name:=myname, Formula:= _
"let" & Chr(13) & "" & Chr(10) & " 源 = Web.Page(Web.Contents(" & """" & "http://f10.eastmoney.com/f10_v2/CompanySurvey.aspx?code=" & myno & """" & "))," _
& Chr(13) & "" & Chr(10) & " Data0 = 源{0}[Data]," & Chr(13) & "" & Chr(10) & " 更改的类型 = Table.TransformColumnTypes(Data0,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " 更改的类型"
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & """" & myname & """" & ";Extended Properties=""""" _
, Destination:=Range("$A$" & L)).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM[" & myname & "]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = AL
Application.Wait Now + TimeValue("00:00:05")
.Refresh BackgroundQuery:=False
End With
myno = Trim(myarr(i, 1))
myname = myno & "1"
AL = myno & "B"
Sheets("股票基本信息").Select
L = Range("B65536").End(xlUp).Row + 1
ActiveWorkbook.Queries.Add Name:=myname, Formula:= _
"let" & Chr(13) & "" & Chr(10) & " 源 = Web.Page(Web.Contents(" & """" & "http://f10.eastmoney.com/f10_v2/CompanySurvey.aspx?code=" & myno & """" & "))," _
& Chr(13) & "" & Chr(10) & " Data1 = 源{1}[Data]," & Chr(13) & "" & Chr(10) & " 更改的类型 = Table.TransformColumnTypes(Data1,{{""Column1"", type text}, {""Column2"", type text}, {""Column3"", type text}, {""Column4"", type text}})" & Chr(13) & "" & Chr(10) & "in" & Chr(13) & "" & Chr(10) & " 更改的类型"
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:= _
"OLEDB;Provider=Microsoft.Mashup.OleDb.1;Data Source=$Workbook$;Location=" & """" & myname & """" & ";Extended Properties=""""" _
, Destination:=Range("$A$" & L)).QueryTable
.CommandType = xlCmdSql
.CommandText = Array("SELECT * FROM[" & myname & "]")
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.ListObject.DisplayName = AL
Application.Wait Now + TimeValue("00:00:05")
.Refresh BackgroundQuery:=False
End With
Next
End Sub
工作簿1.zip
(38.93 KB, 下载次数: 2)
|
|