返回列表 上一主題 發帖

判斷式

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

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


  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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 17# 518587



如圖示 相對應於"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"))
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 我們最大的敵人不是別人.可能是自己。
返回列表 上一主題