我正在尝试编写一个脚本，将网页表中的小时值提取到Excel中

Question

表为15分钟的间隔，但我只需要每小时的值。有没有办法告诉VBA仅读取时间戳到HH：00：00？

的值

Sub GetWaterLevels()
    Dim URL As String
    Dim qt As QueryTable
    Dim ws As Worksheet
    Set ws = ActiveSheet
    'Clears previously loaded data
    ActiveSheet.Range("C4:D85").ClearContents
    URL = "http://waterdata.quinteconservation.ca/KiWIS/KiWIS?service=kisters&type=queryServices&request=getTimeseriesValues&datasource=0&format=html&ts_id=3641042&metadata=true&md_returnfields=station_name,ts_name,ts_unitname&&period=PT10H&width=600&height=400"
    'Downloads the table into excel
    Set qt = ws.QueryTables.Add( _
        Connection:="URL;" & URL, _
        Destination:=Range("C4"))
    With qt
        .RefreshOnFileOpen = False
        .Name = "WaterLevels"
        .FieldNames = True
        .WebSelectionType = xlAllTables
        .Refresh BackgroundQuery:=False
    End With
End Sub

Answer 1

我每天都学到一些新知识。您获得该桌子的方式非常快。我的技能并不像您的技能一样好，但是由于困境，您的技能是我唯一可以提出的答案。我不知道您是否可以使用您的方法选择某些行。我查看了Webtables属性，但对此不了解。我要做的就是用以下代码在工作表上剔除桌子。当我使用您的代码导入表时，将开始在第10行上开始活动数据。您可能必须对其进行调整以适合您的需求。

Sub sortTable()
Dim lastRow As Long, firstRow As Long, myArray1, myArray2, myCounter As Long, i As Long
'   When I ran your getWaterLevels script it put the data starting on row 10
    firstRow = 10
    lastRow = ActiveSheet.Range("C65536").End(xlUp).Row
myCounter = 1
ReDim myArray1(1 To 1)
ReDim myArray2(1 To 1)
Application.ScreenUpdating = False
    For i = firstRow To lastRow
        If Range("C" & i).Value <> "" And InStr(1, Range("C" & i).Value, ":00:00.") > 0 Then
            ReDim Preserve myArray1(1 To myCounter)
            ReDim Preserve myArray2(1 To myCounter)
            myArray1(myCounter) = Range("C" & i)
            myArray2(myCounter) = Range("D" & i)
            myCounter = myCounter + 1
        End If
    Next i

    Cells.Select
    With Selection
        .Font.Name = "Arial"
        .Font.Size = 11
        .Interior.Pattern = xlNone
        .Interior.TintAndShade = 0
        .Interior.PatternTintAndShade = 0
    End With
    Range("C10:D" & lastRow).Select
    Selection.ClearContents
    Range("A1").Select
    myCounter = 10
    For i = LBound(myArray1) To UBound(myArray1)
        Range("C" & myCounter).Value = myArray1(i)
        Range("D" & myCounter).Value = myArray2(i)
        myCounter = myCounter + 1
    Next i
Application.ScreenUpdating = True
End Sub