vba 抓取php网页,一个自动提取网页数据的例子-CSDN博客

本帖最后由引子玄于 2012-7-6 17:27 编辑

既然是网页抓取，咋代码中不见ＵＲＬ呢？不解～～～或许叫：自己电脑里的内存相关数据

的抽取，可能更名副其实些．

Private Sub Worksheet_Change(ByVal Target As Range)

If MsgBox("是否需要记录最新数据？", 4 + 48 + 0, "系统提示!") = vbNo Then End

rr2 = Sheet2.Cells(65536, 1).End(xlUp).Row + 1

rr3 = Sheet3.Cells(65536, 1).End(xlUp).Row + 1

Set D = Columns(1).Find("年")

If Not D Is Nothing Then DT1 = Left(Cells(D.Row, 1), 11)

Set D = Columns(1).Find("阴极铜")

If Not D Is Nothing Then DT2 = Left(Cells(D.Row - 2, 1), 11)

Set r = Columns(2).Find("一号国标")

If Not r Is Nothing Then

Range(Cells(r.Row, 1), Cells(r.Row, 4)).Copy Sheet2.Cells(rr2, 2)

Sheet2.Cells(rr2, 6) = DateValue(DT1)

Sheet3.Cells(rr3, 1) = Now

Range(Cells(r.Row, 1), Cells(r.Row, 4)).Copy Sheet3.Cells(rr3, 2)

Sheet3.Cells(rr3, 6) = DateValue(DT1)

n = n + 1

End If

Set r = Columns(2).Find("二号国标")

If Not r Is Nothing Then Range(Cells(r.Row, 1), Cells(r.Row, 4)).Copy Sheet2.Cells(rr2 + 1, 2): n = n + 1: Sheet2.Cells(rr2 + 1, 6) = DateValue(DT1)

Set r = Columns(2).Find("三号国标")

If Not r Is Nothing Then Range(Cells(r.Row, 1), Cells(r.Row, 4)).Copy Sheet2.Cells(rr2 + 2, 2): n = n + 1: Sheet2.Cells(rr2 + 2, 6) = DateValue(DT1)

Set r = Columns(1).Find("阴极铜")

If Not r Is Nothing Then Range(Cells(r.Row, 1), Cells(r.Row, 4)).Copy Sheet2.Cells(rr2 + 3, 2): n = n + 1: Sheet2.Cells(rr2 + 3, 6) = DateValue(DT2)

Set r = Columns(1).Find("锌锭")

If Not r Is Nothing Then Range(Cells(r.Row, 1), Cells(r.Row, 4)).Copy Sheet2.Cells(rr2 + 4, 2): n = n + 1: Sheet2.Cells(rr2 + 4, 6) = DateValue(DT2)

Range(Cells(r.Row + 2, 1), Cells(r.Row + 2, 4)).Copy Sheet2.Cells(rr2 + 5, 2): n = n + 1: Sheet2.Cells(rr2 + 5, 6) = DateValue(DT2)

Set r = Columns(1).Find("镍")

If Not r Is Nothing Then Range(Cells(r.Row, 1), Cells(r.Row, 4)).Copy Sheet2.Cells(rr2 + 6, 2): n = n + 1: Sheet2.Cells(rr2 + 6, 6) = DateValue(DT2)

With Sheet2

.Range(.Cells(rr2, 1), .Cells(rr2 + n - 1, 1)) = Now

Set D = Columns(4).Find("昨")

If Not D Is Nothing Then B = Left(D, 3)

For I = 0 To 2

J = Cells(rr2 + I, 5)

.Cells(rr2 + I, 5) = B & .Cells(rr2 + I, 5)

'.Cells(rr2 + n, 1).Select

End With

ThisWorkbook.Save

If MsgBox("已保存金属价格记录，是否关闭文件！", 4 + 48 + 0, "温馨提示!") = vbNo Then End

ThisWorkbook.Close

End Sub