暱稱: joey0415
中學生
- 帖子
- 361
- 主題
- 57
- 精華
- 0
- 積分
- 426
- 點名
- 0
- 作業系統
- win7
- 軟體版本
- 2003,2010
- 閱讀權限
- 20
- 性別
- 男
- 註冊時間
- 2010-5-13
- 最後登錄
- 2022-12-8
|
4#
發表於 2015-12-24 22:33
| 只看該作者
回復 4# kaui700 - Sub 博客來()
- X = InputBox("請輸入博客來網址：（速度較快）", "提示")
- ' Application.ScreenUpdating = False
- ' Cells.ClearContents
- Sheets("temp").Activate
- Cells.Delete
-
- surl = "URL;" & X
- With ActiveSheet.QueryTables.Add(Connection:=surl, Destination:=Range("$A$1"))
- .RefreshPeriod = 0
- .WebSelectionType = xlEntirePage
- .WebFormatting = xlWebFormattingNone
- .Refresh BackgroundQuery:=False
- .Delete
- End With
-
- finalrow = Cells(Rows.Count, 1).End(xlUp).Row
- fr = Sheets("整理").Cells(Rows.Count, 1).End(xlUp).Row + 1
- ' Stop
- ' s = 1
- For i = 1 To finalrow
- If Cells(i, 1) = "商品介紹" Then
- Sheets("整理").Cells(fr, 1) = Cells(i + 1, 1)
- End If
-
- If Left(Cells(i, 1), 3) = "作者：" Then
- Sheets("整理").Cells(fr, 2) = Trim(Replace(Replace(Cells(i, 1), "作者：", ""), "新功能介紹", ""))
- End If
-
- If Left(Cells(i, 1), 3) = "繪者：" Then
- Sheets("整理").Cells(fr, 3) = Trim(Replace(Replace(Cells(i, 1), "繪者：", ""), "新功能介紹", ""))
- End If
-
- If Left(Cells(i, 1), 4) = "出版社：" Then
- Sheets("整理").Cells(fr, 4) = Trim(Replace(Replace(Cells(i, 1), "出版社：", ""), "新功能介紹", ""))
- End If
-
- If Left(Cells(i, 1), 5) = "出版日期：" Then
- Sheets("整理").Cells(fr, 5) = Trim(Replace(Replace(Cells(i, 1), "出版日期：", ""), "新功能介紹", ""))
- End If
- Next
-
-
- Sheets("temp").Cells.Delete
- Sheets("整理").Activate
- End Sub
|
|
