您的位置：360文档中心› VBA网抓教程

VBA网抓教程

VBA网抓教程
VBA网抓教程

vba网抓常用方法：

1、xmlhttp/winhttp法：

用xmlhttp/winhttp模拟向服务器发送请求，接收服务器返回的数据。

优点：效率高，基本无兼容性问题。

缺点：需要借助如fiddler的工具来模拟http请求。

2、IE/webbrowser法：

创建IE控件或webbrowser控件，结合htmlfile对象的方法和属性，模拟浏览器操作，获取浏览器页面的数据。

优点：这个方法可以模拟大部分的浏览器操作。所见即所得，浏览器能看到的数据就能用代码获取。

缺点：各种弹窗相当烦人，兼容性也确实是个很伤脑筋的问题。上传文件在IE里根本无法实现。（有实现方法？请一定告诉我）

3、QueryTables法：

因为它是excel自带，所以勉强也算是一种方法。其实此法和xmlhttp类似，也是GET或POST方式发送请求，然后得到服务器的response返回到单元格内。

优点：excel自带，可以通过录制宏得到代码，处理table很方便。代码简短，适合快速获取一些存在于源代码的table里的数据。

缺点：无法模拟referer等发包头（如果你有在QT中模拟referer的方法，请一定告诉我）网抓主题代码:

Sub Main()

Dim strText As String

With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")'

.Open "POST", "", False

.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" .setRequestHeader "Referer", ""

.Send

strText = .responsetext

Debug.Print strText

End With

End Sub

拷贝剪切板:

Sub CopyToClipbox(strText As String)

'文本拷贝到剪贴板

With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

.SetText strText

.PutInClipboard

End With

End Sub

DongYu作业1.rar

(18.29 KB, 下载次数: 88)

2014-10-21 17:05 上传

下载次数: 88

Sub HomerWork1_1()

'新手:DongYu

'作业：1、网站：https://www.360docs.net/doc/758735865.html,/lccp/jrxp.aspx

' 操作：点击“今日在售产品”，获取今日在售产品第一页的数据。

Dim xml As New MSXML2.XMLHTTP, url As String, St As String

Dim arr, brr, ar, i, c

url = "https://www.360docs.net/doc/758735865.html,/lccp/Jrxp.aspx?col=1&tag=desc&date=2014-10-21&page= 2"

With xml

.Open "GET", url, False

.send

St = .responseText

End With

St = Split(Split(St, "

")(1), "
")(0)

arr = Split(St, "")

ReDim brr(1 To UBound(arr), 1 To 9)

For i = 1 To UBound(arr)

ar = arr(i)

brr(i, 1) = Split(Split(ar, "value='")(1), "'")(0) + Split(Split(ar, "")(1), "")(0)

brr(i, 2) = Split(Split(ar, "")(1), "")(0) brr(i, 3) = Split(Split(ar, "")(1), "")(0)

brr(i, 4) = Split(Split(ar, "")(1), "")(0)

brr(i, 5) = Split(Split(ar, "")(2), "")(0)

brr(i, 6) = Split(Split(ar, "")(3), "")(0)

brr(i, 7) = Split(Split(ar, "")(4), "")(0)

brr(i, 8) = Split(Split(ar, "")(5), "")(0)

brr(i, 9) = Split(Split(Split(ar, "")(5), "")(1), ">")(1)

Next i

With ActiveSheet

.Cells.Clear

.Columns("D:E").NumberFormatLocal = "yyyy-m-d"

.[a1].Resize(1, 10) = [{"对比","产品名称","银行","起售日","停售日","币种","管理期(月)","产品类型","预期收益(%)","收益"}]

.[b2].Resize(UBound(brr, 1), 9) = brr

End With

End Sub

Sub 按钮2_单击()

Dim url, html

url = "https://www.360docs.net/doc/758735865.html,/WEB/Flight/FlightSearchResultDefault.aspx?JT=1" url = url & "&OC=PEK" '北京首都机场

url = url & "&DC=SHA" '上海虹口机场

url = url & "&dstDesp=GUANGZHOU%B9%E3%D6%DD"

url = url & "&dst2=CAN"

url = url & "&DD=2014-10-22" '查询日期

url = url & "&DT=7"

url = url & "&BD="

url = url & "&BT=7"

url = url & "&AL=ALL" '全部航空

url = url & "&DR=true"

url = url & "&image.x=33"

url = url & "&image.y=9"

url = url & "&Sn=87bf24142bc0c78727610871f373e0a7"

Set html = CreateObject("htmlfile")

With CreateObject("msxml2.xmlhttp")

.Open "get", url, False

.send

html.body.innerhtml = .responsetext

Set tb = html.all.tags("div")

For i = 0 To tb.Length - 1

If tb(i).classname = "menu_layout2" Or tb(i).classname = "listone_layout" Or tb(i).classname = "listtwo_layout" Or tb(i).classname = "menu_content_small2" Then

n = n + 1

For j = 0 To tb(i).childnodes.Length - 1

Cells(n, j + 1) = tb(i).childnodes(j).innertext

Next

End If

Next

End With

End Sub

Sub 作业1_2_获取航班信息数据()

'网站：https://www.360docs.net/doc/758735865.html,/S1/GNCX/

'操作：点击“查询”，获取航班信息数据。

Dim St As String, Url$, arr, brr, Crr

Dim S1$, S2$, i%, j%, rng As Range

Url = "https://www.360docs.net/doc/758735865.html,/WEB/Flight/FlightSearchResultDefault.aspx?JT=1&O C=PEK&DC=SHA&dstDesp=GUANGZHOU%B9%E3%D6%DD&dst2=CAN&DD=2014-10-22&DT=7&BD=&BT=7 &AL=ALL&DR=true&image.x=37&image.y=9&Sn=87bf24142bc0c78727610871f373e0a7"

With CreateObject("WinHttp.WinHttpRequest.5.1")

.Open "GET", Url, False

.Send

St = .responsetext

End With

'

If InStr(St, "

") < 1 Then

Cells(1, 1) = "抱歉！没有满足条件的航班，请重新输入查询条件！ "

Else

St = Split(Split(St, "

")(1),

"


")(0)

With ActiveSheet

Cells(1, 1) = Split(Split(St, "")(1), "")(0)

arr = Split(St, "

") '航空公司分组

For i = 1 To UBound(arr)

S1 = arr(i)

Crr = Split(S1, "

")

ReDim brr(1 To UBound(Crr) + 2, 1 To 5) '班次UBound(S1) + 1，航空公司及机行+1，航线+1

'航空公司

brr(1, 1) = Trim(Split(Split(S1, "

")(1),

"

")(0)) '中国东方航空公司

brr(1, 2) = Trim(Split(Split(S1, "

")(1),

"

")(0)) '航班

brr(1, 2) = Trim(Split(Split(brr(1, 2), "font"">")(1),

"")(0))

brr(1, 3) = Trim(Split(Split(S1, "

")(2),

"

")(0)) ''机型：333

'飞行线路

brr(2, 1) = Trim(Split(Split(S1, "

class=""menu1_layout"">")(1), "

")(0)) '北京首都机场

brr(2, 2) = Trim(Split(Split(S1, "

class=""menu2_layout"">")(1), "

")(0)) '（22:00）

brr(2, 3) = Trim(Split(Split(S1, "

class=""menu3_layout"">")(1), "

")(0)) '经停：0

brr(2, 4) = Trim(Split(Split(S1, "

class=""menu1_layout"">")(2), "

")(0)) '上海虹桥机场

brr(2, 5) = Trim(Split(Split(S1, "

class=""menu2_layout"">")(2), "

")(0)) '（23:55）

'飞行班次

For j = 1 To UBound(Crr)

S2 = Crr(j)

' Debug.Print S2

brr(2 + j, 1) = Trim(Split(Split(S2, "

class=""menu4_layout"">")(1), "

")(0)) '票价

brr(2 + j, 2) = Trim(Split(Split(S2, "

class=""menu5_layout"">")(1), "")(0)) '舱位'

brr(2 + j, 3) = Trim(Split(Split(S2, "

class=""menu6_layout"">")(1), "")(0)) '票数'

'……

Next j

Set rng = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0) rng.Resize(UBound(brr, 1), 5) = brr

Next i

End With

End If

End Sub

Sub 作业1_2_航空公司获取()

'网站：https://www.360docs.net/doc/758735865.html,/S1/GNCX/

'操作：点击“查询”，获取航班信息数据。

Dim strText As String

With CreateObject("MSXML2.XMLHTTP")

.Open "GET", "https://www.360docs.net/doc/758735865.html,/images/airlinecontrol.js", False .Send

strText = .responsetext

Debug.Print ByteToStr(.responseBody, "GB2312")

End With

End Sub

Function ByteToStr(arrByte, strCharset As String) As String

With CreateObject("Adodb.Stream")

.Type = 1 'adTypeBinary

.Open

.Write arrByte

.Position = 0

.Type = 2 'adTypeText

.Charset = strCharset

ByteToStr = .Readtext

.Close

End With

End Function

Sub Main()

Dim strText As String

Const saltkey As String = "oUuXXXX"'请复制你自己的Cookie粘贴到这里。下同

Const sid As String = "tXXXX"

Const auth As String = "a30eEZTXXXXXXXXXXXXXXXXXXXX"

Const cookiereport As String = "f1fXXXXXXXXXXXXXXXXXXXXXXXX"

Const ulastactivity As String = "84cXXXXXXXXXXXXXXXXXXXX"

Const touclick As String = "70a9vPXXXXXXXXXXXXXXXXXXXX"

Const member_login_uid As String = "218917"

Const member_login_sid As String = "tXXXX"

With CreateObject("WinHttp.WinHttpRequest.5.1")

.Open "GET", "https://www.360docs.net/doc/758735865.html,/home.php?mod=space&do=thread&view=me ", False

.setRequestHeader "Cookie", _

"5WOj_b676_saltkey=" & saltkey _

& ";5WOj_b676_sid=" & sid _

& ";5WOj_b676_auth=" & auth _

& ";5WOj_b676_cookiereport=" & cookiereport _

& ";5WOj_b676_ulastactivity=" & ulastactivity _

& ";5WOj_b676_touclick=" & touclick _

& ";5WOj_b676_member_login_uid=" & member_login_uid _

& ";5WOj_b676_member_login_sid=" & member_login_sid

.Send

strText = .responsetext

Debug.Print strText

End With

End Sub

Sub Main()

Dim strText As String

Const saltkey As String = "oUuXXXX"

Const auth As String = "a30eEZTXXXXXXXXXXXXXXXXXXXX"

With CreateObject("WinHttp.WinHttpRequest.5.1")

.Open "GET", "https://www.360docs.net/doc/758735865.html,/home.php?mod=space&do=thread&view=me ", False

.setRequestHeader "Cookie", _

"5WOj_b676_saltkey=" & saltkey _

& ";5WOj_b676_auth=" & auth

.Send

strText = .responsetext

Debug.Print strText

End With

End Sub

Sub Main()

Dim strText As String

With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")

.Open "POST", "https://www.360docs.net/doc/758735865.html,/lz/etpsInfo.do?method=viewDetail", False

.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

' .setRequestHeader "Referer", ""

.send "etpsId=150000012002040300047"

strText = .responseText

Debug.Print strText

End With

End Sub

Sub Main()

Dim strText As String

With CreateObject("WinHttp.WinHttpRequest.5.1") 'CreateObject("MSXML2.XMLHTTP") '

.Open "POST", "https://www.360docs.net/doc/758735865.html,/lz/etpsInfo.do?method=viewDetail", False .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"

.setRequestHeader "Referer", "https://www.360docs.net/doc/758735865.html,/lz/etpsInfo.do?method=doSearch"

.send "etpsId=150000012002040300047"

strText = .responseText

Debug.Print strText

End With

End Sub

Sub Main()

Dim strText As String

With CreateObject("WinHttp.WinHttpRequest.5.1")

.Open "GET", "https://www.360docs.net/doc/758735865.html,:8080/costRegulatory/project.do?method=showProjectList&is Visitor=1&f_id=11011&t1413902083242", False

.setRequestHeader "Referer", "https://www.360docs.net/doc/758735865.html,:8080/costRegulatory/user.do?method=changeIndex&fareaId=1 "

.setRequestHeader "Cookie", "E0685A9F6B708A1F1039BF2322B82A35"

.Send

strText = .responsetext

Debug.Print strText

End With

End Sub

Sub Main()

Dim strText As String

Dim strCookie As String

With CreateObject("WinHttp.WinHttpRequest.5.1")

.Option(6) = False ' 禁止重定向，以获取原网页信息

.Open "GET", "https://www.360docs.net/doc/758735865.html,:8080/costRegulatory/user.do?method=changeIndex&fareaId=1 ", False

.Send

strText = .getAllResponseHeaders '获取所有的回应头信息

Debug.Print strText: Stop '在立即窗口里查看头信息

strCookie = Split(Split(strText, "Set-Cookie: ")(1), ";")(0) '取出Cookie 值

End With

'在同一个winhttp对象里能保留cookie，为了体现设置cookie的作用，启用一个新的winhttp对象

With CreateObject("WinHttp.WinHttpRequest.5.1")

.Open "GET", "https://www.360docs.net/doc/758735865.html,:8080/costRegulatory/project.do?method=showProjectList&is Visitor=1&f_id=11011&t1413902083242", False

.setRequestHeader "Referer", "https://www.360docs.net/doc/758735865.html,:8080/costRegulatory/user.do?method=changeIndex&fareaId=1 "

.setRequestHeader "Cookie", strCookie '模拟Cookie

.Send

strText = .responsetext

Debug.Print strText

End With

End Sub

Sub Main()

Dim strText As String

With CreateObject("WinHttp.WinHttpRequest.5.1")

.Open "GET", "https://www.360docs.net/doc/758735865.html,:8080/costRegulatory/user.do?method=changeIndex&fareaId=1 ", False

.Send '此次send是为了获取cookie

.Open "GET", "https://www.360docs.net/doc/758735865.html,:8080/costRegulatory/project.do?method=showProjectList&is Visitor=1&f_id=11011&t1413902083242", False

.setRequestHeader "Referer", "https://www.360docs.net/doc/758735865.html,:8080/costRegulatory/user.do?method=changeIndex&fareaId=1 "

.Send

strText = .responsetext

Debug.Print strText

End Sub

Sub Main()

Dim strText As String

Const saltkey As String = "oUuXXXX"'请复制你自己的Cookie粘贴到这里。下同

Const sid As String = "tXXXX"

Const auth As String = "a30eEZTXXXXXXXXXXXXXXXXXXXX"

Const cookiereport As String = "f1fXXXXXXXXXXXXXXXXXXXXXXXX"

Const ulastactivity As String = "84cXXXXXXXXXXXXXXXXXXXX"

Const touclick As String = "70a9vPXXXXXXXXXXXXXXXXXXXX"

Const member_login_uid As String = "218917"

Const member_login_sid As String = "tXXXX"

With CreateObject("WinHttp.WinHttpRequest.5.1")

.Open "GET", "https://www.360docs.net/doc/758735865.html,/home.php?mod=space&do=thread&view=me ", False

.setRequestHeader "Cookie", _

"5WOj_b676_saltkey=" & saltkey _

& ";5WOj_b676_sid=" & sid _

& ";5WOj_b676_auth=" & auth _

& ";5WOj_b676_cookiereport=" & cookiereport _

& ";5WOj_b676_ulastactivity=" & ulastactivity _

& ";5WOj_b676_touclick=" & touclick _

& ";5WOj_b676_member_login_uid=" & member_login_uid _

& ";5WOj_b676_member_login_sid=" & member_login_sid

.Send

strText = .responsetext

Debug.Print strText

End With

End Sub

Sub Main()

Dim strText As String

Const saltkey As String = "oUuXXXX"

Const auth As String = "a30eEZTXXXXXXXXXXXXXXXXXXXX"

With CreateObject("WinHttp.WinHttpRequest.5.1")

.Open "GET", "https://www.360docs.net/doc/758735865.html,/home.php?mod=space&do=thread&view=me ", False

.setRequestHeader "Cookie", _

"5WOj_b676_saltkey=" & saltkey _

& ";5WOj_b676_auth=" & auth

strText = .responsetext

Debug.Print strText

End With

End Sub

Sub Main()

Dim strText As String

With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")

.Open "GET", "https://www.360docs.net/doc/758735865.html,/home.php?mod=space&uid=218917&do=thread&view=me&type =reply&from=space&mobile=yes", False

.setRequestHeader "User-Agent", "Mozilla/4.0 (compatible: MSIE 7.0; Windows Phone OS 7.0; Trident/3.1; IEMobile/7.0; SAMSUNG; SGH-i917)"

.Send

strText = .responsetext

Debug.Print strText

End With

End Sub

Sub Main()

Dim strText As String

Dim strHost As String

Dim strURL As String

strHost = "https://www.360docs.net/doc/758735865.html,"

With CreateObject("WinHttp.WinHttpRequest.5.1")

.Open "GET", strHost & "/WEB/Flight/WaitingSearch.aspx?JT=1&OC=PEK&DC=SHA&dstDesp=GUANGZHOU%B9%E3%D6%D D&dst2=CAN&DD=2014-10-22&DT=7&BD=&BT=7&AL=ALL&DR=true&image.x=37&image.y=14", False

.setRequestHeader "Referer", "https://www.360docs.net/doc/758735865.html,/S1/GNCX/"

.Send

strText = .responsetext

strURL = Split(Split(strText, "setTimeout(""window.location.replace('")(1), "'")(0)

.Open "GET", strHost & strURL, False

.Send

strText = .responsetext

Debug.Print strText

End Sub

Sub Main()

Dim strText As String

Dim strHost As String

Dim strURL As String

strHost = "https://www.360docs.net/doc/758735865.html,"

With CreateObject("WinHttp.WinHttpRequest.5.1")

.Open "GET", strHost & "/WEB/Flight/WaitingSearch.aspx?JT=1&OC=PEK&DC=SHA&dstDesp=GUANGZHOU%B9%E3%D6%D D&dst2=CAN&DD=2014-10-22&DT=7&BD=&BT=7&AL=ALL&DR=true&image.x=37&image.y=14", False

.setRequestHeader "Referer", "https://www.360docs.net/doc/758735865.html,/S1/GNCX/"

.Send

strText = .responsetext

strURL = Split(Split(strText, "setTimeout(""window.location.replace('")(1), "'")(0)

.Open "GET", strHost & strURL, False

.Send

strText = .responsetext

Debug.Print strText

End With

End Sub

本帖最后由wcymiss 于2014-10-24 15:18 编辑

对获取数据作个小结：

1、清除缓存cookie历史记录后用fiddler抓包。

2、搜索所需数据，找到数据真实网页（别忘了对fiddler事先进行设置，否则有可能搜不到数据）

3、用代码模拟Request框的Raw按钮下的内容：

首先只写Open和Send，看是否有数据；（xmlhttp）（winhttp有时解析utf-8字符不成功，所以初始测试首选xmlhttp）

无数据的话，首选模拟Referer；（winhttp）

仍然不行的话，观察Cookie或是URL或SendData中有无动态参数。有的话需要追根朔源。（这步需要时间和耐心）

其他模拟一般都是小概率事件，如果遇到了我只能说你很不幸。

最后，祝你成功！

Sub Main()

Dim strText As String

With CreateObject("WinHttp.WinHttpRequest.5.1")

.SetProxy 2, "218.75.100.114:8080"

.Open "GET", "https://www.360docs.net/doc/758735865.html,/ic.asp", False

.send

strText = ByteToStr(.Responsebody, "GB2312")'请自行拷贝之前的常用函数

Debug.Print strText

End With

End Sub

Sub Main()

Const strFileName As String = "C:\测试EH下载文件.rar"

With CreateObject("MSXML2.XMLHTTP") 'CreateObject("WinHttp.WinHttpRequest.5.1")

.Open "GET", "https://www.360docs.net/doc/758735865.html,/forum.php?mod=attachment&aid=MTA2MjQ1MHw0MDQxMTAzOHw xNDE0MTIxNTg0fDIxODkxN3w4MDk5MjQ%3D", False

.Send

ByteToFile .responsebody, strFileName

End With

End Sub

Function unescape(strTobecoded As String) As String

With CreateObject("msscriptcontrol.scriptcontrol")

.Language = "JavaScript"

unescape = .Eval("unescape('" & strTobecoded & "');")

End With

End Function

Function JSEval(s As String) As String

With CreateObject("MSScriptControl.ScriptControl")

.Language = "javascript"

JSEval = .Eval(s)

End With

End Function

Function EnCodeByHTML(strText As String)

With CreateObject("htmlfile")

.write strText

EnCodeByHTML = .body.innertext

End With

End Function

有坛友问ResponseBody和ResponseText的区别，这里补充说下：

1、ResponseBody是二进制的数据，是服务器传来的没有经过任何加工的数据。在网络中，文本一般都是以utf-8编码，所以xmlhttp/winhttp对象的ResponseText是按照utf-8编码把ResponseBody转换而成，也就是：Response Text=ByteToStr(Response Body,"UTF-8") 至于问“为什么ByteToStr(Response Text,"GB2312")没有结果”，原因是：一是参数类型不对，ByteToStr的第一参数是二进制数据的Byte数组类型，Response Text是文本类型，系统提示出错；二是，即使进行了将文本转成二进制数据的转换（如下面代码里的b7=s这样的转换），这种转换也是按照某种编码进行的，这样的二进制已经进行过一次编码加工了，你再用ByteToStr就得不到原来的字符了。

处理数据的通用方法：

1、数组法：

用split和数组，循环将所需数据取出。

优点：不需其他对象辅助，起点低，会数组即可。

缺点：需要分析数据结构，对于复杂结构的数据，需要多步才能完成。

Sub Main()

Dim strText As String

Dim arrRow, arrCell

Dim i As Long, j As Long, n As Long

Dim arrColumn

Dim arrData(1 To 1000, 1 To 10)

With CreateObject("MSXML2.XMLHTTP")

.Open "GET", "https://www.360docs.net/doc/758735865.html,/lccp/jrxp.aspx", False

.Send

strText = .responsetext

End With

arrColumn = Array(, , 9, 12, 14, 16, 18, 20, 22, 24, 26)

arrRow = Split(strText, "name='proTest' ")

For i = 1 To UBound(arrRow)

arrCell = Split(arrRow(i), ">")

n = n + 1

arrData(n, 1) = Split(Split(arrCell(0), "value='")(1), "'")(0)

For j = 2 To 10

arrData(n, j) = Split(arrCell(arrColumn(j)), "<")(0)

Next

Next

Cells.Clear

Range("a1:j1").Value = Split("产品名称是否在售银行起售日停售日币种管理期(月) 产品类型预期收益(%) 收益类型", " ")

Range("a2").Resize(n, 10).Value = arrData

End Sub

2、正则法：

用正则拆解字符串，提取匹配数据，循环取出。

优点：即便复杂结构的数据，也有可能一步到位。

缺点：需要学习正则知识。

Sub Main()

Const gc As String = "" '群号

Const bkn As String = "" '从fiddler中获取

Const uin As String = "" 'QQ号

Const skey As String = "" '从fiddler中获取

Dim strText As String

Dim RegMatch As Object

Dim arrData(1 To 1000, 1 To 2)

Dim n As Long

With CreateObject("WinHttp.WinHttpRequest.5.1")

.Open "GET", "https://www.360docs.net/doc/758735865.html,/cgi-bin/qun_info/get_group_members_new?gc=" & gc & "&bkn=" & bkn, False

.setRequestHeader "Cookie", "uin=o" & uin & "; skey=" & skey

.Send

strText = .responsetext

Debug.Print strText

End With

With CreateObject("VBScript.Regexp")

.Global = True

.Pattern = "{""b"":\d+,""g"":\d+,""n"":""([^""]*)"",""u"":(\d+)}"

For Each RegMatch In .Execute(strText)

arrData(n, 1) = RegMatch.submatches(0)

arrData(n, 2) = RegMatch.submatches(1)

Next

End With

Set RegMatch = Nothing

Cells.Clear

Range("a1:b1").Value = Array("昵称", "QQ号")

Range("a2").Resize(n, 2).Value = arrData

End Sub

处理table

table数据处理，除了之前的两种通用方法外，还有以下几种方法：

1、html法

将table数据写入htmldocument对象，然后循环取出表格的各个元素。

优点：可以利用htmldocument对象整理表格。

缺点：需要学习html相关知识。

以17楼作业二为例：

Sub Main()

Dim strText As String

Dim arrData(1 To 1000, 1 To 3)

Dim i As Long, j As Long

Dim TR As Object, TD As Object

With CreateObject("MSXML2.XMLHTTP")

.Open "POST", "https://www.360docs.net/doc/758735865.html,/Template/WebService1.asmx/Present3DList", False

.setRequestHeader "Content-Type", "application/json"

.Send "{pageindex:'1',lottory:'TC7XCData_jiangS',pl3:'',name:'江苏七星彩',isgp: '0'}"

strText = Split(JSEval(.responsetext), "

End With

With CreateObject("htmlfile")

.write strText

i = 0

For Each TR In .all.tags("table")(2).Rows

j = 0

For Each TD In TR.Cells

j = j + 1

arrData(i, j) = TD.innerText

Next

Next

End With

Set TR = Nothing

Set TD = Nothing

Cells.Clear

Range("C:C").NumberFormat = "@" '设置文本格式以显示数字前面的0

Range("a1").Resize(i, 3).Value = arrData

End Sub

Function JSEval(s As String) As String

With CreateObject("MSScriptControl.ScriptControl")

.Language = "javascript"

JSEval = .Eval(s)

End With

End Function

2、QueryTable法：

这个是excel自带的网抓利器。个人觉得它最大的优势就是处理table很方便。

优点：处理table方便，代码简短。

缺点：会产生定义名称。多页循环时每页都会产生行字段名称，需要后续处理删除。

Sub Main()

Cells.Delete

With

ActiveSheet.QueryTables.Add("url;https://www.360docs.net/doc/758735865.html,/lccp/jrxp.aspx", Range("a1"))

.WebFormatting = xlWebFormattingNone '不包含格式

.WebSelectionType = xlSpecifiedTables '指定table模式

.WebTables = "2" '第2张table

.Refresh False

End With

End Sub

3、复制粘贴法：

table部分的文字可以直接复制到单元格内，且保留数据原格式。

优点：只需取出table部分，不需分析数据内部结构。代码编写简便。

缺点：有时格式反而是累赘。

Sub Main()

Dim strText As String

With CreateObject("MSXML2.XMLHTTP")

.Open "GET", "https://www.360docs.net/doc/758735865.html,/lccp/jrxp.aspx", False

.Send

strText = .responsetext

End With

strText = "")(0) & ""

CopyToClipbox strText

Cells.Clear

Range("a1").Select

ActiveSheet.Paste

End Sub

Sub CopyToClipbox(strText As String)

'文本拷贝到剪贴板

With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")

.SetText strText

.PutInClipboard

End With

End Sub

处理xml数据

Sub Main()

ThisWorkbook.XmlImport _

URL:="https://www.360docs.net/doc/758735865.html,/fzjy/tjsj/pztj/pzrtj/2014/index.xml", _ ImportMap:=Nothing, _

Overwrite:=True, _

Destination:=ActiveSheet.Range("a1")

End Sub

Sub Main()

Dim arrEM(1 To 4), arrEMname

Dim arrData(1000, 1 To 4)

Dim i As Long, j As Long

With CreateObject("MSXML2.XMLHTTP")

.Open "GET", "https://www.360docs.net/doc/758735865.html,/fzjy/tjsj/pztj/pzrtj/2014/index.xml", False

.send

arrEMname = Array(, "productid", "tradingday", "volume", "openinterest") With .responseXML

For i = 1 To 4

Set arrEM(i) = .getElementsByTagName(arrEMname(i))

Next

For i = 0 To arrEM(1).Length - 1

For j = 1 To 4

arrData(i, j) = arrEM(j)(i).Text

Next

Next

End With

End With

Cells.Clear

Range("a1:d1").Value = Array("品种", "日期", "总成交量", "总持仓量")

Range("a2").Resize(i, 4).Value = arrData

End Sub

初识JSON

JSON数据的特点：

1、用方括号扩住的是数组，数组内元素以逗号分隔。如：["甲","乙","丙"]、[1,2,3]

2、用花括号扩住的是对象，对象内各属性以逗号分隔，属性名和属性值以冒号分隔。同一对象里的属性名不会重复。如对象{"name":"甲","age":36}，含name、age两个属性，属性值分别为“甲”和36。

3、对象的属性值可以是数组。数组的元素可以是对象。JSON数据就是数组对象嵌套的大集合。比如，下面的JSON数据记录了甲乙二人的基本信息：

JSON转换成vba对象

1、JSON数组在vba内需要用For Each来获取其元素：（For Each 后面的变量不能定义为

Object类型）

1、JSON数组在vba内需要用For Each来获取其元素：（For Each 后面的变量不能定义为

Object类型）

Sub Test()

Const strJSON As String = "[""甲"",""乙"",""丙""]"

Dim objJSON As Object

Dim Cell '这里不能定义为object类型

With CreateObject("msscriptcontrol.scriptcontrol")

.Language = "JavaScript"

.AddCode "var mydata =" & strJSON

Set objJSON = .CodeObject

End With

Stop '查看vba本地窗口里objJSON对象以了解JSON数据在vba里的形态

For Each Cell In objJSON.mydata

Debug.Print Cell

Next

End Sub

2、JSON对象在vba内可直接用“对象.属性”的方法获取，但当名称不被vba允许时，用

CallByName函数获取：

Sub Test()

Const strJSON As String = "{""name"":""甲"",""age"":36}"

Dim objJSON As Object

With CreateObject("msscriptcontrol.scriptcontrol")

.Language = "JavaScript"

.AddCode "var mydata=" & strJSON

Set objJSON = .CodeObject

End With

Stop '查看本地窗口

Debug.Print objJSON.mydata.age

Debug.Print https://www.360docs.net/doc/758735865.html, '此句出错

End Sub

登陆:

Sub Main()

Const username As String = "vbatest"

Const password As String = "12341234"

Excel+vba入门教程

VBA入门系列讲座 1.1 VBA是什么 直到90年代早期,使应用程序自动化还是充满挑战性的领域.对每个需要自动 化的应用程序,人们不得不学习一种不同的自动化语言.例如:可以用excel的宏语言来使excel自动化,使用word BASIC使word自动化,等等.微软决定让它开 发出来的应用程序共享一种通用的自动化语言--------Visual Basic For Application(VBA),可以认为VBA是非常流行的应用程序开发语言VASUAL BASIC 的子集.实际上VBA是”寄生于”VB应用程序的版本.VBA和VB的区别包括如下 几个方面: 1. VB是设计用于创建标准的应用程序,而VBA是使已有的应用程序(excel 等)自动化 2. VB具有自己的开发环境,而VBA必须寄生于已有的应用程序. 3. 要运行VB开发的应用程序,用户不必安装VB,因为VB开发出的应用程序 是可执行文件(*.EXE),而VBA开发的程序必须依赖于它的”父”应用程 序,例如excel. 尽管存在这些不同,VBA和VB在结构上仍然十分相似.事实上,如果你已经了解 了VB,会发现学习VBA非常快.相应的,学完VBA会给学习VB打下坚实的基础.而且,当学会在excel中用VBA创建解决方案后,即已具备在word access OUTLOOK 中用VBA创建解决方案的大部分知识. FOXPRO PROWERPOINT VBA一个关键特征是你所学的知识在微软的一些产品中可以相互转化. VBA可以称作excel的“遥控器”. VBA究竟是什么?更确切地讲,它是一种自动化语言,它可以使常用的程序自动化,可以创建自定义的解决方案. 此外,如果你愿意,还可以将excel用做开发平台实现应用程序. 1.2 Excel环境中基于应用程序自动化的优点 也许你想知道VBA可以干什么?使用VBA可以实现的功能包括: 1. 使重复的任务自动化. 2. 自定义excel工具栏,菜单和界面. 3. 简化模板的使用. 4. 自定义excel,使其成为开发平台. 5. 创建报表. 6. 对数据进行复杂的操作和分析.

Excelvba入门教学教程

VBA 入门系列讲座 1.1 VBA 是什么 直到90年代早期,使应用程序自动化还是充满挑战性的领域.对每个需要自动 化的应用程序，人们不得不学习一种不同的自动化语言.例如:可以用excel 的宏语 言来使excel 自动化，使用word BASIC 使word 自动化，等等.微软决定让它开发出 来的应用程序共享一种通用的自动化语言 -------------------------- V isual Basic For Application （VBA ）,可以认为VBA 是非常流行的应用程序开发语言 VASUAL BASIC 的子集.实际上VBA 是”寄生于”VB 应用程序的版本.VBA 和VB 的区别包 括如下几个方面： VB 是设计用于创建标准的应用程序，而VBA 是使已有的应用程序（excel 等）自动化 VB 具有自己的开发环境，而VBA 必须寄生于已有的应用程序. 要运行VB 开发的应用程序，用户不必安装VB,因为VB 开发出的应用程 序是 可执行文件（*.EXE ）,而VBA 开发的程序必须依赖于它的”父”应用 程序， 例如excel. 尽管存在这些不同,VBA 和VB 在结构上仍然十分相似.事实上,如果你已经了 解了 VB,会发现学习VBA 非常快.相应的，学完VBA 会给学习VB 打下坚实的基 础.而且，当学会在excel 中用VBA 创建解决方案后，即已具备在 word access OUTLOOK FOX PRO P ROWER POINT 中用VBA 创建解决方案的大部分知识. VBA 一个关键特征是你所学的知识在微软的一些产品中可以相互转化 . VBA 可以称作excel 的“遥控器”. VBA 究竟是什么？更确切地讲，它是一种自动化语言，它可以使常用的程序自动 化,可以创建自定义的解决方案. 此外，如果你愿意，还可以将excel 用做开发平台实现应用程序. 1.2 Excel 环境中基于应用程序自动化的优点 也许你想知道VBA 可以干什么？使用VBA 可以实现的功能包括： 使重复的任务自动化. 自定义excel 工具栏,菜单和界面. 简化模板的使用. 自定义exceI 使其成为开发平台. 创建报表. 对数据进行复杂的操作和分析. 1. 2. 3. 1. 2. 3. 4. 5. 6.

Excel VBA基础教程两篇

Excel VBA基础教程两篇 篇一：Excel VBA基础教程 Excel VBA教程是把VB编程应用在Excel平台的一套实用教程，Excel +VBA双剑合壁，他可以帮助我们实现Excel原本实现不了的功能，可以让工作变得更高效，可以让操作变得变方便，可以把重复性的操作变得更有趣，随心所欲的定制自己的工作平台，还可以针对企业来开发各种系统如，人事管理系统、仓库系统、进存销系统等，对于经常要处理大量数据工作的朋友，学会了这套VBA教程你的工作将游刃有余。 标题 Excel VBA基础教程 Excel VBA基础教程 第一章：Excel VBA基础知识 1-1、Excel VBA教程简介 1-2、宏在工作中的运用

1-3、Excel VBA基础 1-4、Excel VBA窗口介绍 1-5、Excel VBA代码编写规则1-6、对象 1-7、属性 1-8、方法 1-9、常量与变量 1-10、数据类型 1-11、判断语句之IF 1-12、判断语句IF之多条件1-12B、If条件判断小结

1-13、判断语句之SELECT 1-14、循环语句之DO...LOOP 1-15、循环语句之DO...LOOP实例 1-16、循环语句之DO WHILE...LOOP 1-17、循环语句之DO UNTIL...LOOP 1-18、循环语句之WHILE与UNTIL位置变化1-18B、DO...LOOP 语法小结 1-19、.循环语句之FOR EACH...NEXT 1-20、循环语句之FOX...NEXT 1-20B、For...NEXT小结与实例 1-21、用语句FOR...NEXT制作九九乘法表

excel VBA编程入门教程

excel VBA编程入门教程 回看到“excel 编程入门教程”求助贴，不料被别人捷足先登。没想到今天又看到这个求助经 验贴，而且又有优先评优支持当然要领取了。本人也算上个世纪的编程老鸟，虽然对于当前 的主流技术不是非常精通，但是对于Excel VBA，还是略知一二的。下面就来和大家分享一 下Excel VBA编程入门经验。 工具/原料 熟练操作Excel，有一定得VB编程经验，别说你的电脑没装office啊步骤/方法 点击Windows左下方，“开始”-“程序” -“Microsoft Office”-"Microsoft Office Excel 2003", 打开Excel,如下图示。 点击按下图所示，点击菜单“工具”-“宏”-“Visual Basic 编辑器”

然后会出现“Visual Basic 编辑器”窗体，如下图示 你已经启动了VB编程环境，这就是你的编程平台。 按下图所示，点击“Visual Basic 编辑器”中的菜单“插入”-“用户窗体”

接着出现“可编辑窗体”，如下图所示 上图,红色框中所示为“可编辑窗体”，你可以在上面进行可视化编程，就类似于我们现实生活中的画布，你可以在窗体上通过左侧绿色框内的“工具箱”绘制命令按钮、文字框、标签等编程控件。你也可以通过鼠标点击红色框中窗体外围的8个的操作手柄，拖动窗体的大小，直观形象的进行可视化编程。操作手柄如下图示

红色圈内的句点就是操作手柄。当然，你也可以对窗体的显示的文字进行调整，这就需要在最左侧的属性窗口中修改它的“Caption”属性，考虑到这时编程入门，仅仅是教大家一个简单的编程流程，所以我就不多废话了。 接着，用鼠标单击左侧“工具箱”内的“命令按钮控件”，如下图所示 此时，鼠标光标会变成一个“十字准星”和“命令按钮”状，因鼠标形状无法截图，此处就不贴图了。你可以用鼠标拖动，在可编辑窗体上绘制一个任意大小的命令按钮。如下图示: 同样，这个“命令按钮”四周也有8个操作手柄，你可以用鼠标来调整它的大小。 最关键的时刻到了，马上就可以进行编程了。用鼠标双击“命令按钮CommandButton1”，会出现如下窗口

ACAD VBA初级教程

ACAD VBA初级教程第一课:入门 1.为什么要写这个教程 市面上ACAD VBA的书不多，它的帮助是英文版的，很多人看不懂。 2.什么是Autocad VBA？ VBA是Visual Basic for Applications的英文缩写，它是一个功能强大的开发工具，学好VBA可以成倍甚至成百、成万倍提高工作效率，在工作中，有很多任务仅用ACAD命令不可能完成的，只要学好VBA就可以做到，相信到时候您一定会得到同事的佩服、老板的器重。 3、VBA有多难？ 相信大家都知道Basic是的含义。应该承认，我的水平还不高，错误之处在所难免，如果大家发现错误一定要提出批评，以便及时更正。 4、怎样学习VBA？ 介绍大家一个学习公式：信心+恒心=开心。仔细阅读本教程，完成例题，在学习的过程中一定要多思考，多想一些是什么、为什么。 5、现在我们开始编写第一个程序：画一百个同心圆 第一步：复制下面的红色代码 第二步：在模型空间按快捷键Alt+F8，出现宏窗口 第三步：在宏名称中填写C100，点“创建”、“确定” 第四步：在Sub c100()和End Sub之间粘贴代码 第五步：回到模型空间，再次按Alt+F8，点击“运行” Sub c100() Dim cc(0 To 2) As Double '声明坐标变量 cc(0) = 1000 '定义圆心座标 cc(1) = 1000 cc(2) = 0

For i = 1 To 1000 Step 10 '开始循环 Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆 Next i End Sub 也许您还看不懂上面的代码，这没有关系，只要能把同心画出来就可以了，祝您成功。 第二课编程基础 本课主要任务是对上一课的例程进行详细分析 下面是源码： Sub c100() Dim cc(0 To 2) As Double '声明坐标变量 cc(0) = 1000 '定义圆心座标 cc(1) = 1000 cc(2) = 0 For i = 1 To 1000 Step 10 '开始循环 Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆 Next i End Sub 先看第一行和最后一行： Sub C100() …… End Sub C100是宏的名称，也叫过程名称，当用户执行C100时程序将运行sub和end sub之间的所有指令。 第二行： Dim cc(0 To 2) As Double '声明坐标变量 后半段“'声明坐标变量”自动变为绿色字体，它是代码语句的注释，它不会影响程序运行，它的作用是告诉阅读者程序员的想法。对于简单的程序，一般不需要写注释，如果要编写非常复杂的程序，最好要多加注

Excel_VBA数组入门教程集合

Excel VBA数组入门教程集合 1. 前言：不要把VBA数组想的太神秘，它其实就是一组数字而已。 2. 数组的维数： Sub 数组示例() Dim x As Long, y As Long Dim arr(1 To 10, 1 To 3) '创建一个可以容下10行3列的数组空间 For x = 1 To 4 For y = 1 To 3 arr(x, y) = Cells(x, y) '通过循环把单元格区域a1:c4的数据装进数组中 Next y Next x MsgBox arr(4, 3) '根据提供的行数和列数显示数组 arr(1, 2) = "我改一下试试" '你可以随时修改数组内指定位置的数据 MsgBox arr(1, 2) End Sub 总结：二维是由行和列表示的数组，如ARR(3,2)表示数组中第3排第2列的元素。而一维数组只是由一个元素决定，如ARR（4）表示数组中第4个元素 3. 把单元格数据搬入内存： 一、声明： Dim arr as Variant '声明一个变量，不能声明其他数据类型 Dim arr(1 to 10, 1 to 2) , 这种声明也是错误的，固定大小的VBA数组是不能一次性装入单元格数据 或：dim arr()这种声明方式是声明一个动态数组，也可以装入单元格区域，构成一个VBA数组。 二、装入 arr =range("a9:c100") '装入很简单，变量 = 单元格区域 三、读出 装入数组后的单元格数值，可以按数组名称(行数，列数) 直接读取该位置的值，如下面的代码。 Msgbox arr(3,2) '就可以取出搬过去的而构成的数组第3行第2列的内容 四、示例 Sub s3() Dim arr() '声明一个动态数组（动态指不固定大小） Dim arr1 '声明一个Variant类型的变量

autocad vba初级教程 (强烈推荐)

Autocad VBA初级教程 (第二课编程基础) Autocad VBA初级教程 (第三课编程基础二) Autocad VBA初级教程 (第四课程序的调试和保存) Autocad VBA初级教程 (第五课画函数曲线) Autocad VBA初级教程 (第六课数据类型的转换) Autocad VBA初级教程 (第七课写文字) Autocad VBA初级教程 (第八课:图层操作) Autocad VBA初级教程 (第九课:创建选择集) 18 Autocad VBA初级教程 (第十课:画多段线和样条线) 20 Autocad VBA初级教程 (第十一课:动画基础) 23 Autocad VBA初级教程 (第十二课:参数化设计基础) 26

Autocad VBA初级教程(第一课:入门) 1.为什么要写这个教程 市面上ACAD VBA的书不多，它的帮助是英文版的，很多人看不懂。其实我转行已经好几年了，而且手艺也慢慢生疏了，写个教程对自己来说也是一次复习。 2.什么是Autocad VBA？ VBA是Visual Basic for Applications的英文缩写，它是一个功能强大的开发工具，学好VBA可以成倍甚至成百、成万倍提高工作效率，在工作中，有很多任务仅用ACAD命令不可能完成的，只要学好VBA就可以做到，相信到时候您一定会得到同事的佩服、老板的器重。 3、VBA有多难？ 相信大家都知道Basic是的含义。应该承认，我的水平还不高，错误之处在所难免，如果大家发现错误一定要提出批评，以便及时更正。 4、怎样学习VBA？ 介绍大家一个学习公式：信心+恒心=开心。仔细阅读本教程，完成例题，在学习的过程中一定要多思考，多想一些是什么、为什么。本教程将陆续发布在CAD 世界论坛上，您不需要付费就可以学习。本作者在此郑重承诺：关于本教程中有任何疑问，可以跟贴提问，只要有时间，本人一定会耐心解答。我不会发到任何人的邮箱中，您自己在论坛上找就可以了，请不要再向我索要这份教程。 5、现在我们开始编写第一个程序：画一百个同心圆 第一步：复制下面的代码 第二步：在模型空间按快捷键Alt+F8，出现宏窗口 第三步：在宏名称中填写C100，点“创建”、“确定” 第四步：在Sub c100()和End Sub之间粘贴代码 第五步：回到模型空间，再次按Alt+F8，点击“运行” Sub c100() Dim cc(0 To 2) As Double '声明坐标变量 cc(0) = 1000 '定义圆心座标 cc(1) = 1000 cc(2) = 0 For i = 1 To 1000 Step 10 '开始循环 Call ThisDrawing.ModelSpace.AddCircle(cc, i * 10) '画圆 Next i End Sub 也许您还看不懂上面的代码，这没有关系，只要能把同心画出来就可以了，祝您成功。

EXCEL_VBA应用教程

EXCEL VBA应用教程－－第1讲什么是EXCEL VBA 第1讲什么是EXCEL VBA 作者：https://www.360docs.net/doc/758735865.html,/landmao 1.1 为什么要学习EXCEL VBA 现在，财务软件已经趋于普及，会计人员的工作效率大幅度提高，减轻了会计人员大工作强度。财务软件但优点是从数据但输入、处理、输出实现了一体化，在会计数据但利用方面，尽管财务软件一直都作改进，但客观上还是满足不了管理工作但要求。因此，作实际工作中，EXCEL被大量应用，EXCEL但特点是简单易用，操作灵活，大大地弥补了会计软件地不足。但是，EXCEL处理数据的缺点是，每一步都要人工操作和控制，对重复性的工作，每次都要重复去作。 EXCEL VBA能够将重复的工作编写成程序，这样就能够提高效率和避免人为操作的错误。 1.2 什么是VBA VBA(Visual Basic For Applications)是微软开发出来在其桌面应用程序中执行通用的自动化(OLE)任务的编程语言。VBA是Visual Basic的一个子集,VBA 不同于VB，原因是VBA要求有一个宿主应用程序才能远行（需要在EXCEL等软件的运行下才能运行），而且不能用于创建独立应用程序。而VB可用于创建独立的应用程序。VBA可使常用的过程或者进程自动化，可以创建自定义的解决方案，最适用于来定制已有的桌面应用程序。 通常意义上的VBA就是在Office中包含着的一种加强Office功能的Basic 语言。经过发展，在Office中，Word、Excel、Access、PowerPoint等个软件都有了自己的程序设计语言，分别称为WordBasic、ExcelBasic、AccessBasic、PowerPointBasic (在Outlook中的开发语言为Visual Basic Scripting Edition)。通常统一称为VBA（VB for Application）。 本讲座，主要基于EXCEL VBA进行讲解。 VBA和VB的区别包括如下几个方面: （1） VB是设计用于创建标准的应用程序,而VBA是在已有的应用程序(EXCEL 等)下运行，实行有关操作、处理、查询等的自动化，提高效率。 （2）VB具有自己的开发环境,而VBA必须寄生于已有的应用程序（如EXCEL）。 （3）要运行VB开发的应用程序,用户不必安装VB,因为VB开发出的应用程序是可执行文件(*.EXE),可独立运行。而VBA开发的程序必须依赖于它的"父"应用程序,例如EXCEL，如编写的EXCEL VBA程序，没有安装EXCEL是无法运行的。

Excel VBA数组入门教程范文

Excel VBA数组入门教程 1. 前言：不要把VBA数组想的太神秘，它其实就是一组数字而已。 2. 数组的维数： Sub 数组示例() Dim x As Long, y As Long Dim arr(1 To 10, 1 To 3) '创建一个可以容下10行3列的数组空间 For x = 1 To 4 For y = 1 To 3 arr(x, y) = Cells(x, y) '通过循环把单元格区域a1:c4的数据装进数组中 Next y Next x MsgBox arr(4, 3) '根据提供的行数和列数显示数组 arr(1, 2) = "我改一下试试" '你可以随时修改数组内指定位置的数据 MsgBox arr(1, 2) End Sub 总结：二维是由行和列表示的数组，如ARR(3,2)表示数组中第3排第2列的元素。而一维数组只是由一个元素决定，如ARR（4）表示数组中第4个元素

3. 把单元格数据搬入内存： 一、声明： Dim arr as Variant '声明一个变量，不能声明其他数据类型 Dim arr(1 to 10, 1 to 2 ) , 这种声明也是错误的，固定大小的VBA数组是不能一次性装入单元格数据 或：dim arr() 这种声明方式是声明一个动态数组，也可以装入单元格区域，构成一个VBA数组。 二、装入 arr =range("a9:c100") '装入很简单，变量= 单元格区域 三、读出 装入数组后的单元格数值，可以按数组名称(行数，列数) 直接读取该位置的值，如下面的代码。 Msgbox arr(3,2) '就可以取出搬过去的而构成的数组第3行第2列的内容 四、示例 Sub s3()

excelvba实例教程#060：使用vba自动生成图表

在实际工作中我们常用图表来表现数据间的某种相对关系，一般采用手工插入的方式，而使用VBA代码可以在工作表中自动生成图表，如下面的示例代码。 1.Sub ChartAdd() 2. Dim myRange As Range 3. Dim myChart As ChartObject 4. Dim R As Integer 5. With Sheet1 6.. 7.R = .Range("A65536").End(xlUp).Row 8.Set myRange = .Range("A" & 1 & ":B" & R) 9.Set myChart = .(120, 40, 400, 250) 10.With 11..ChartType = xlColumnClustered 12..SetSourceData Source:=myRange, PlotBy:=xlColumns 13..ApplyDataLabels ShowValue:=True 14..HasTitle = True 15.. = "图表制作示例" 16.With . 17. .Size = 20 18. .ColorIndex = 3 19. .Name = "华文新魏" 20.End With 21.With . 22. .ColorIndex = 8 23. .PatternColorIndex = 1 24. .Pattern = xlSolid 25.End With 26.With . 27. .ColorIndex = 35 28. .PatternColorIndex = 1 29. .Pattern = xlSolid 30.End With

EXCEL编程入门教程

EXCEL编程初学者教程 新术语：“宏”，指一系列EXCEL能够执行的VBA语句。 以下将要录制的宏非常简单，只是改变单元格颜色。请完成如下步骤： 1)打开新工作簿，确认其他工作簿已经关闭。 2)选择A1单元格。调出“常用”工具栏。 3)选择“工具”—“宏”—“录制新宏”。 4)输入“改变颜色”作为宏名替换默认宏名，单击确定,注意，此时状态栏中显示“录制”，特别是“停止录制”工具栏也显示出来。替换默认宏名主要是便于分别这些宏。 ★宏名最多可为255个字符，并且必须以字母开始。其中可用的字符包括：字母、数字和下划线。宏名中不允许出现空格。通常用下划线代表空格。 5)选择“格式”的“单元格”，选择“图案”选项中的红色,单击“确定”。 6)单击“停止录制”工具栏按钮，结束宏录制过程。 ※如果“停止录制”工具栏开始并未出现，请选择“工具”—“宏”—“停止录制”。 录制完一个宏后就可以执行它了。 1.4 执行宏 当执行一个宏时，EXCEL按照宏语句执行的情况就像VBA代码在对EXCEL进行“遥控”。但VBA的“遥控”不仅能使操作变得简便，还能使你获得一些使用EXCEL 标准命令所无法实现的功能。而且，一旦熟悉了EXCEL的“遥控”，你都会奇怪自己在没有这些“遥控”的情况下，到底是怎么熬过来的。要执行刚才录制的宏，可以按以下步骤进行： 1）选择任何一个单元格，比如A3。 2）选择“工具”—“宏”—“宏”，显示“宏”对话框。 3）选择“改变颜色”，选择“执行”，则A3单元格的颜色变为红色。试着选择其它单元格和几个单元格组成的区域，然后再执行宏，以便加深印象。 1.5 查看录制的代码 到底是什么在控制EXCEL的运行呢?你可能有些疑惑.好,让我们看看VBA的语句吧. 1）选择“工具”—“宏”—“宏”，显示“宏”对话框。 2）单击列表中的“改变颜色”,选择“编辑”按钮。 此时，会打开VBA的编辑器窗口（VBE）。关于该编辑器，以后再详细说明，先将注意力集中到显示的代码上。代码如下：（日期和姓名会有不同）

相关主题
相关文档
最新文档