求助:Excel VBA提取下载网页数据
下面的代码是一位老师写的,我对用Excle提取网页下载不懂,还请有知道的老师帮我注解一下这些代码吧,谢谢OptionExplicitTypeDataInfoEndType...
下面的代码是一位老师写的,我对用Excle提取网页下载不懂,还请有知道的老师帮我注解一下这些代码吧,谢谢
Option Explicit
Type DataInfo
End Type
Public myDataInfo As DataInfo
Public JS_Name As String
Public objJS As Object
Public arr As Variant
Sub Main()
Dim strRgStartName As String '起始单元格名称
Dim strRgEndName As String '结束单元格名称
Dim strTemp As String
Dim strT() As String
Dim lngR As Long, lngC As Long
Application.Cursor = xlWait
Application.ScreenUpdating = False
GetBasicInfo '初始化数据
'如果无数据则退出
If myDataInfo.RecordCount = 0 Then
Application.Cursor = xlDefault
Application.ScreenUpdating = True
MsgBox "无数据!", vbCritical
Exit Sub
End If
strRgStartName = "A1" '从A1单元格开始
strRgEndName = Cells(myDataInfo.RecordCount, myDataInfo.lngCols).Address(0, 0)
Sheet1.UsedRange.ClearContents
arr = Sheet1.Range(strRgStartName & ":" & strRgEndName)
'逐条读取
For lngR = 1 To myDataInfo.RecordCount
strTemp = objJS.eval(JS_Name & ".data[" & lngR - 1 & "]")
strT = Split(strTemp, ",")
For lngC = 0 To UBound(strT)
arr(lngR, lngC + 1) = strT(lngC)
Next
Next
'填充
Sheet1.Range(strRgStartName & ":" & strRgEndName) = arr
Application.Cursor = xlDefault
Application.ScreenUpdating = True
End Sub 展开
Option Explicit
Type DataInfo
End Type
Public myDataInfo As DataInfo
Public JS_Name As String
Public objJS As Object
Public arr As Variant
Sub Main()
Dim strRgStartName As String '起始单元格名称
Dim strRgEndName As String '结束单元格名称
Dim strTemp As String
Dim strT() As String
Dim lngR As Long, lngC As Long
Application.Cursor = xlWait
Application.ScreenUpdating = False
GetBasicInfo '初始化数据
'如果无数据则退出
If myDataInfo.RecordCount = 0 Then
Application.Cursor = xlDefault
Application.ScreenUpdating = True
MsgBox "无数据!", vbCritical
Exit Sub
End If
strRgStartName = "A1" '从A1单元格开始
strRgEndName = Cells(myDataInfo.RecordCount, myDataInfo.lngCols).Address(0, 0)
Sheet1.UsedRange.ClearContents
arr = Sheet1.Range(strRgStartName & ":" & strRgEndName)
'逐条读取
For lngR = 1 To myDataInfo.RecordCount
strTemp = objJS.eval(JS_Name & ".data[" & lngR - 1 & "]")
strT = Split(strTemp, ",")
For lngC = 0 To UBound(strT)
arr(lngR, lngC + 1) = strT(lngC)
Next
Next
'填充
Sheet1.Range(strRgStartName & ":" & strRgEndName) = arr
Application.Cursor = xlDefault
Application.ScreenUpdating = True
End Sub 展开
1个回答
展开全部
Option Explicit '强制定义变量(如果有本句存于开始,则所有变量需定义)
Type DataInfo '类型DataInfo
'
End Type 'End类型
'
Public myDataInfo As DataInfo '公有的myDataInfo类型为DataInfo
'
Public JS_Name As String '公有的JS_名称类型为字符串
Public objJS As Object '公有的objJS类型为对象
Public arr As Variant '公有的arr类型为Variant
Sub Main() '子程序Main()
'
Dim strRgStartName As String '起始单元格名称 '定义变量strRgStartName类型为字符串'起始单元格名称
Dim strRgEndName As String '结束单元格名称 '定义变量strRgEndName类型为字符串'结束单元格名称
Dim strTemp As String '定义变量strTemp类型为字符串
Dim strT() As String '定义变量strT()类型为字符串
Dim lngR As Long, lngC As Long '定义变量lngR类型为长整型值,lngC类型为长整型值
Application.Cursor = xlWait ' 应用程序的光标=xlWait
Application.ScreenUpdating = False ' 应用程序的屏幕刷新=False
GetBasicInfo '初始化数据 'GetBasicInfo'初始化数据
'如果无数据则退出
If myDataInfo.RecordCount = 0 Then '如果 myDataInfo的RecordCount=0 则执行
Application.Cursor = xlDefault ' 应用程序的光标=xlDefault
Application.ScreenUpdating = True ' 应用程序的屏幕刷新=True
MsgBox "无数据!", vbCritical '<消息框>:"无数据!",vbCritical
Exit Sub '退出子程序
End If 'If判断过程结束
strRgStartName = "A1" '从A1单元格开始 'strRgStartName="A1"'从A1单元格开始
strRgEndName = Cells(myDataInfo.RecordCount, myDataInfo.lngCols).Address(0, 0) 'strRgEndName=<单元格>坐标( myDataInfo的RecordCount, myDataInfo的lngCols )的Address(0,0)
Sheet1.UsedRange.ClearContents ' Sheet1的已使用区域的清除内容
arr = Sheet1.Range(strRgStartName & ":" & strRgEndName) 'arr= Sheet1的<单元格>区域(strRgStartName & ":" & strRgEndName)
'逐条读取
For lngR = 1 To myDataInfo.RecordCount '设定变量范围为lngR=1到 myDataInfo的RecordCount
strTemp = objJS.eval(JS_Name & ".data[" & lngR - 1 & "]") 'strTemp= objJS的eval(JS_名称 & ".data[" & lngR-1 & "]")
strT = Split(strTemp, ",") 'strT=<分割字符串>(strTemp,",")
For lngC = 0 To UBound(strT) '设定变量范围为lngC=0到<数组上限>(strT)
arr(lngR, lngC + 1) = strT(lngC) 'arr(lngR,lngC+1)=strT(lngC)
Next '下一个
Next '下一个
'填充
Sheet1.Range(strRgStartName & ":" & strRgEndName) = arr ' Sheet1的<单元格>区域(strRgStartName & ":" & strRgEndName)=arr
Application.Cursor = xlDefault ' 应用程序的光标=xlDefault
Application.ScreenUpdating = True ' 应用程序的屏幕刷新=True
End Sub '子程序结束
Type DataInfo '类型DataInfo
'
End Type 'End类型
'
Public myDataInfo As DataInfo '公有的myDataInfo类型为DataInfo
'
Public JS_Name As String '公有的JS_名称类型为字符串
Public objJS As Object '公有的objJS类型为对象
Public arr As Variant '公有的arr类型为Variant
Sub Main() '子程序Main()
'
Dim strRgStartName As String '起始单元格名称 '定义变量strRgStartName类型为字符串'起始单元格名称
Dim strRgEndName As String '结束单元格名称 '定义变量strRgEndName类型为字符串'结束单元格名称
Dim strTemp As String '定义变量strTemp类型为字符串
Dim strT() As String '定义变量strT()类型为字符串
Dim lngR As Long, lngC As Long '定义变量lngR类型为长整型值,lngC类型为长整型值
Application.Cursor = xlWait ' 应用程序的光标=xlWait
Application.ScreenUpdating = False ' 应用程序的屏幕刷新=False
GetBasicInfo '初始化数据 'GetBasicInfo'初始化数据
'如果无数据则退出
If myDataInfo.RecordCount = 0 Then '如果 myDataInfo的RecordCount=0 则执行
Application.Cursor = xlDefault ' 应用程序的光标=xlDefault
Application.ScreenUpdating = True ' 应用程序的屏幕刷新=True
MsgBox "无数据!", vbCritical '<消息框>:"无数据!",vbCritical
Exit Sub '退出子程序
End If 'If判断过程结束
strRgStartName = "A1" '从A1单元格开始 'strRgStartName="A1"'从A1单元格开始
strRgEndName = Cells(myDataInfo.RecordCount, myDataInfo.lngCols).Address(0, 0) 'strRgEndName=<单元格>坐标( myDataInfo的RecordCount, myDataInfo的lngCols )的Address(0,0)
Sheet1.UsedRange.ClearContents ' Sheet1的已使用区域的清除内容
arr = Sheet1.Range(strRgStartName & ":" & strRgEndName) 'arr= Sheet1的<单元格>区域(strRgStartName & ":" & strRgEndName)
'逐条读取
For lngR = 1 To myDataInfo.RecordCount '设定变量范围为lngR=1到 myDataInfo的RecordCount
strTemp = objJS.eval(JS_Name & ".data[" & lngR - 1 & "]") 'strTemp= objJS的eval(JS_名称 & ".data[" & lngR-1 & "]")
strT = Split(strTemp, ",") 'strT=<分割字符串>(strTemp,",")
For lngC = 0 To UBound(strT) '设定变量范围为lngC=0到<数组上限>(strT)
arr(lngR, lngC + 1) = strT(lngC) 'arr(lngR,lngC+1)=strT(lngC)
Next '下一个
Next '下一个
'填充
Sheet1.Range(strRgStartName & ":" & strRgEndName) = arr ' Sheet1的<单元格>区域(strRgStartName & ":" & strRgEndName)=arr
Application.Cursor = xlDefault ' 应用程序的光标=xlDefault
Application.ScreenUpdating = True ' 应用程序的屏幕刷新=True
End Sub '子程序结束
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询