查询足球亚盘 最早开盘时间

Sub test()
    Dim html As Object, D As Object, W As Object
    Dim arrData(1 To 1000, 1 To 20)
    Dim reg As Object
    Dim n As Long, file As String
    
    'file网页文件来源www.okooo.com
    
    Sheet1.Cells.Clear
    
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = False        '单选择
        .Filters.Clear        '清除文件过滤器
        '.Filters.Add "html Files", "*.htm;*.html"
        .Filters.Add "All Files", "*.*" '设置两个文件过滤器
        
        If .Show = -1 Then
            'FileDialog 对象的 Show 方法显示对话框,并且返回 -1(如果您按 OK)和 0(如果您按 Cancel)。
            file = .SelectedItems(1)
            
            'MsgBox "您选择的文件是:" & .SelectedItems(1), vbOKOnly + vbInformation, "Aisa Handicap"
        End If
    End With
    
    Set html = CreateObject("MSXML2.XMLHTTP")
        html.Open "GET", file, False
        html.setRequestHeader "Accept-Language", "zh-cn"
        html.send: strhtml = html.responsebody
        strhtml = StrConv(strhtml, vbUnicode)
        
    Set html2 = CreateObject("htmlfile")
        html2.body.innerhtml = strhtml
        
    Set html_temp1 = html2.getElementById("data_main_content") '根据ID查找table
        html2.write html_temp1.innerhtml
        
        i = 0
        For Each TR In html2.all.tags("table")(0).Rows '
            i = i + 1
            j = 0
            For Each TD In TR.Cells
                j = j + 1
                Cells(i, j) = TD.innerText
                Debug.Print arrData(i, j)
            Next
        Next
           

    With CreateObject("VBscript.regexp")
        .Global = ture
        .Pattern = "bright\sfeedbackObj.{24}" '取时间
            For n = 0 To 100 Step 1
            For Each D In .Execute(strhtml)
                'Debug.Print D
                Cells(n + 1, 15) = Split(Split(D, "bright feedbackObj"" title=""开盘时间: 赛前")(1), """") '去掉两种字符串
                strhtml = .Replace(strhtml, "")
            Next
            Next
    End With
     
   
    
        
    '排序,先把时分时间转成分钟数
     For n = 1 To 100 Step 1
        If Cells(n, 15) <> "" Then
        Cells(n, 16) = 60 * CLng(Split(Cells(n, 15), "时")(0)) + Split(Split(Cells(n, 15), "时")(1), "分")(0)
        End If
    Next
    'hong
    ActiveWindow.SmallScroll Down:=-6
    Columns("P:P").Select
    ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("sheet1").Sort.SortFields.Add Key:=Range("P:P") _
        , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("sheet1").Sort
        .SetRange Range("A1:Q100")
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWindow.SmallScroll Down:=-3
    
    With CreateObject("VBscript.regexp")
        .Global = ture
        .Pattern = "<title.*</title>" '取标题
            For n = 0 To 100 Step 1
            For Each D In .Execute(strhtml)
                Cells(n + 1, 17) = Split(Split(D, "<title>")(1), "</title>")(0) '添加标题
                'MsgBox Cells(n + 1, 17)
                strhtml = .Replace(strhtml, "")
            Next
            Next
    End With
    '添加颜色
    
    Columns("C:C").Select
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
        
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With
    
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
    
    Columns("E:E").Select
    Selection.FormatConditions.AddColorScale ColorScaleType:=3
    Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority
    Selection.FormatConditions(1).ColorScaleCriteria(1).Type = _
        xlConditionValueLowestValue
        
    With Selection.FormatConditions(1).ColorScaleCriteria(1).FormatColor
        .Color = 8109667
        .TintAndShade = 0
    End With
    
    Selection.FormatConditions(1).ColorScaleCriteria(2).Type = _
        xlConditionValuePercentile
    Selection.FormatConditions(1).ColorScaleCriteria(2).Value = 50
    With Selection.FormatConditions(1).ColorScaleCriteria(2).FormatColor
        .Color = 8711167
        .TintAndShade = 0
    End With
    
    Selection.FormatConditions(1).ColorScaleCriteria(3).Type = _
        xlConditionValueHighestValue
    With Selection.FormatConditions(1).ColorScaleCriteria(3).FormatColor
        .Color = 7039480
        .TintAndShade = 0
    End With
    
    Columns("A:Q").Select
    With Selection.Font
        .Name = "宋体"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Cells(1, 17).Select

End Sub



  • 0
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 3
    评论
评论 3
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值