Board logo

標題: 判斷式 [打印本頁]
作者: 518587    時間: 2014-11-16 13:05     標題: 抓取網站資料後，每筆擷取的資料"儲存格位置不一樣"

如附件，我有N筆選手網址，但是想擷取的"黃色儲存格部分"每一筆的儲存格位置都不一樣，該如何把它整理到"資料彙整"裡面呢?
能否請大大幫忙，順便附上說明! 謝謝
[attach]19554[/attach]
作者: jackdream    時間: 2014-11-17 14:09

參考看看...
用關鍵字,找尋所在的列位
Dim j As Integer
j = Columns("A").Find("Print", lookat:=xlPart).Row     '裡面的Print是要搜尋的關鍵字
作者: 518587    時間: 2014-11-17 15:13

回復 2# jackdream

[attach]19564[/attach]
  大大  可是我要的資料(黃色部分)該如何搜尋關鍵字呢? 每一筆的資料都不一樣!

還有選手1他多了紅色框框的部分，可是選手2卻沒有(選手2黃色的部分也會自動往上移動)，能否請大大再幫幫忙修改一下程式!謝謝!

[attach]19562[/attach][attach]19563[/attach]
作者: jackdream    時間: 2014-11-17 16:14

一樣的方式,不過我沒研究網站抓下的格式,其餘的語法你再改變測試看看

例如要找選手1的資料,先找Prize Money,往下一列找到最後一欄

Dim j As Integer
Dim k As Integer
j = Cells.Find("Prize Money", lookat:=xlPart).Row     '找 Prize Money 列位
k = Cells(j + 1, 256).End(xlToLeft).Column                   '在Prize Money下一列,回傳最後一欄
作者: 518587    時間: 2014-11-17 16:17

回復 4# jackdream


    [attach]19567[/attach]大大不好意思，能否請您幫我看看程式 這段指令需要加在哪裡才是對的?謝謝您^^[attach]19567[/attach]
作者: 518587    時間: 2014-11-17 16:19

回復 4# jackdream


    大大 可我兩位選手的資料位置都不一樣 是否要寫一個判斷式?如果是我該怎麼去編寫@@?
作者: jackdream    時間: 2014-11-17 16:25

我看不太懂你給的問題.

這麼說吧,如果你是人工作業,你會怎麼抓對應的資料?
會找那些關鍵字?
作者: 518587    時間: 2014-11-17 16:33

回復 7# jackdream


   我有N比選手資料，可是選手有些有出現紅色框框的部分(例如選手一)
   但有些不會(例如選手二)

   我想把程式寫成判斷式如果是選手一的情況，那我就依照"PRIZEMONEY"的方式下去找他的下一格
   如果我是選手二的情況，那我就從"PRIZE MONEY"去找他右下那一個!

   現在我是卡在判斷式不知道該如何編寫? 請問能請大大幫忙嗎 謝謝!
作者: jackdream    時間: 2014-11-17 16:55

底下紅色字體是我增加的,其餘我是copy你的程式沒做修改

Sub 巨集2()

On Error Resume Next   '表示當一個執行階段錯誤產生時，程式控制立刻到發生錯誤陳述式接下去的陳述式，而繼續執行下去
Dim myrng As Range
Dim myhyps As Hyperlinks
Dim myhyp As Hyperlink


Dim j As Integer
Dim k As Integer


'從網頁擷取資料
For n = 1 To 1
Sheets("擷取資料").Select
Cells.Select
    Selection.ClearContents
    Range("A1").Select
    '取出網頁路徑
    Set myrng = Sheets("選手網址").Cells(n + 1, 1)
    With myrng
    Set myhyps = .Hyperlinks
    Set myhyp = myhyps(1)
   
    End With

    'myhyp.Address變數可以直接用網址取代

    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;" & myhyp.Address _
        , Destination:=Range("$A$1"))
        .Name = "Novak-Djokovic_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
   

   j = Cells.Find("Prize Money", lookat:=xlPart).Row     '找 Prize Money 列位
    MsgBox Cells(j + 1, 6)      '如果資料固定在第六欄,就只需要上面那行和此行程式
   
    'k = Cells(j + 1, 256).End(xlToLeft).Column   '在Prize Money下一列,回傳最後一欄...如果資料不固定在第六欄,才需要改為此行程式
   
Next n
   
End Sub
作者: 518587    時間: 2014-11-17 17:09

本帖最後由 518587 於 2014-11-17 17:15 編輯

回復 9# jackdream


    謝謝大大的指導
    但是我還有一問題想請教您
    選手一的"PRIZE MONEY"那一欄是 2014  current的
    選手二的"PRIZE MONEY"那一欄是 career high的
    兩個是不一樣的，請問我該如何撰寫讓他判斷?

    整理後的資料我想如下這樣呈現，但是如果用大大的程式抓是否會不一樣呢?
   (我想呈現的)
   選手編號       2014  current-PRIZE MONEY                                      career high-PRIZE MONEY
     一                   $316,909(儲存格位置:F229)                                       $1,924,273(儲存格位置:F231)
     二                                                                                                            $152,766(儲存格位置:F227)
作者: jackdream    時間: 2014-11-17 17:33

回復  jackdream


    選手一的"PRIZE MONEY"那一欄是 2014  current的
    選手二的"PRIZE MONEY"那一欄是 career high的
    兩個是不一樣的，請問我該如何撰寫讓他判斷?.
518587 發表於 2014-11-17 17:09



    問題在於,什麼情況下要使用2014  current ,又什麼情況下改使用career high ?
作者: 518587    時間: 2014-11-17 17:46

問題在於,什麼情況下要使用2014  current ,又什麼情況下改使用career high ?
jackdream 發表於 2014-11-17 17:33



    選手一有2014  current 、career high
    選手二沒有，只有career high

如圖綠色部分~[attach]19568[/attach][attach]19569[/attach]
作者: 518587    時間: 2014-11-17 23:37     標題: 判斷式

我已經把判斷式寫好，不知道是不是我寫的判斷式有問題
選手1 的排名(圖片中紅色部分) 我想放在"資料彙整"的I2  (2014 CURRENT排名)
選手2的排名(圖片中紅色部分)  我想放在"資料彙整"的L3  (單打排名)

雖然"擷取資料"中的儲存格是一樣，但意義不一樣。

可是我在寫判斷式讓他試跑的過程中
選手1的(2014 CURRENT排名) 總是被整理到 L2
請問能否請大大幫我看看是哪裡出問題 順便幫我解釋一下 謝謝!
[attach]19570[/attach][attach]19571[/attach][attach]19572[/attach]

[attach]19573[/attach]
作者: jackdream    時間: 2014-11-18 08:11

選手一有2014  current 、career high
    選手二沒有，只有career high
518587 發表於 2014-11-17 17:46


意思是...
如果有2014  current,就使用2014  current當作PRIZE MONEY,
如果沒有2014  current,就使用career high當作PRIZE MONEY

但,這樣的判斷方式,不論是選手一或二,
答案都在PRIZE MONEY下一列的最後一格資料,
不是嗎?

跟昨天給的語法,找到的結果相同
http://forum.twbts.com/redirect.php?goto=findpost&ptid=12801&pid=72209&fromuid=12
作者: 518587    時間: 2014-11-18 15:16

回復 14# jackdream


    大大您好，謝謝您幫我解決其問題，但我在13樓又出現一個問題，能否請您再幫我看看!
    萬分感謝!
作者: GBKEE    時間: 2014-11-18 16:40

本帖最後由 GBKEE 於 2014-11-18 16:50 編輯

回復 15# 518587
參考一下,選手姓名,年齡,身高,體重.可自己寫寫看


[attach]19578[/attach]
  1. Option Explicit
  2. Sub Ex()
  3. Dim n As Integer, myrng As Range, mySh As Worksheet, myAr
  4. '從網頁擷取資料
  5. For n = 1 To 2
  6. With Sheets("擷取資料")
  7.     If .QueryTables.Count >= 1 Then .QueryTables("Novak-Djokovic_1").Delete  '太多的QueryTable 物件會佔用資源
  8.     .UsedRange.ClearContents
  9.     Set myrng = Sheets("選手網址").Cells(n + 1, 1)
  10.     Set mySh = Sheets("資料彙整")
  11.     With .QueryTables.Add(Connection:="URL;" & myrng.Text, Destination:=.Range("$A$1"))
  12.         .Name = "Novak-Djokovic_1"
  13.         .FieldNames = True
  14.         .RowNumbers = False
  15.         .FillAdjacentFormulas = False
  16.         .PreserveFormatting = True
  17.         .RefreshOnFileOpen = False
  18.         .BackgroundQuery = True
  19.         .RefreshStyle = xlInsertDeleteCells
  20.         .SavePassword = False
  21.         .SaveData = True
  22.         .AdjustColumnWidth = True
  23.         .RefreshPeriod = 0
  24.         .WebSelectionType = xlEntirePage
  25.         .WebFormatting = xlWebFormattingNone
  26.         .WebPreFormattedTextToColumns = True
  27.         .WebConsecutiveDelimitersAsOne = True
  28.         .WebSingleBlockTextImport = False
  29.         .WebDisableDateRecognition = False
  30.         .WebDisableRedirections = False
  31.         .Refresh BackgroundQuery:=False
  32.     End With
  33.     Set myrng = .Cells.Find("W-L", Lookat:=xlWhole)  '尋找"W-L"
  34.     If Not myrng Is Nothing Then
  35.         With .Cells(myrng.Row, "A")
  36.             Select Case myrng.Column
  37.              Case 3  '"W-L" 在C欄
  38.                 myAr = Array("", "", "", .Range("B3"), .Range("D2"), .Range("B4"), .Range("F2"), "", "", .Range("B6"), .Range("D5"), .Range("B7"))
  39.                 '單打排名(W-L):.Range("D2")  -> 2014/3/6 這"(是3勝6敗)"在何處?
  40.             Case 4   '"W-L" 在D欄
  41.                 myAr = Array(.Range("B3"), .Range("D2"), .Range("F6"), .Range("B5"), .Range("D4"), .Range("B6"), .Range("F4"), .Range("B8"), .Range("F7"), .Range("B10"), .Range("D9"), .Range("B11"))
  42.                 '雙打排名(W-L): .Range("D9") ->2014/6/27 這"(是6勝27敗)"在何處?
  43.             End Select
  44.         End With
  45.         With Sheets("資料彙整").Cells(n + 1, "I").Resize(, UBound(myAr) + 1)
  46.             .Value = myAr
  47.             .Cells(IIf(myrng.Column = 4, 11, 5)).NumberFormatLocal = "yyyy/m/d"
  48.             
  49.         End With
  50.     End If
  51.     End With
  52.    Next n
  53.    ActiveWorkbook.Save
  54.    MsgBox "處理完畢!"
  55. End Sub
複製代碼
作者: 518587    時間: 2014-11-18 17:10

回復 16# GBKEE


    不好意思  能否請大大幫我做一個簡單明瞭的註解!! 感恩~~
作者: GBKEE    時間: 2014-11-19 16:44

回復 17# 518587

[attach]19582[/attach]

如圖示 相對應於"S D"的Range
  1.   Case 4   '"W-L" 在D欄
  2.                 myAr = Array(.Range("B3"), .Range("D2"), .Range("F6"), .Range("B5"), .Range("D4"), .Range("B6"), .Range("F4"), .Range("B8"), .Range("F7"), .Range("B10"), .Range("D9"), .Range("B11"))
複製代碼
作者: 518587    時間: 2014-11-20 11:04

回復 18# GBKEE


    大大，請問為何要抓Range("B3"), .Range("D2"), .Range("F6"), .Range("B5"), .Range("D4"), .Range("B6"), .Range("F4"), .Range("B8"), .Range("F7"), .Range("B10"), .Range("D9"), .Range("B11"
    這幾個呢?
作者: GBKEE    時間: 2014-11-20 12:55

本帖最後由 GBKEE 於 2014-11-20 12:57 編輯

回復 19# 518587
所抓取Range的值是否正確?
  1.   With .Cells(myrng.Row, "A")'<-以這位置為基準點的Range,-> .Range("B3"), .Range("D2"), .Range("B4"),...  請在看一次#18的圖片,這樣了解碼?
  2.             Select Case myrng.Column
  3.              Case 3  '"W-L" 在C欄
  4.                 myAr = Array("", "", "", .Range("B3"), .Range("D2"), .Range("B4"), .Range("F2"), "", "", .Range("B6"), .Range("D5"), .Range("B7"))
  5.                 '單打排名(W-L):.Range("D2")  -> 2014/3/6 這"(是3勝6敗)"在何處?
  6.             Case 4   '"W-L" 在D欄
  7.                 myAr = Array(.Range("B3"), .Range("D2"), .Range("F6"), .Range("B5"), .Range("D4"), .Range("B6"), .Range("F4"), .Range("B8"), .Range("F7"), .Range("B10"), .Range("D9"), .Range("B11"))
  8.                 '雙打排名(W-L): .Range("D9") ->2014/6/27 這"(是6勝27敗)"在何處?
  9.             End Select
  10.        End With
複製代碼




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)