宏根据工作表名称从Web下载数据

时间:2015-06-14 14:23:02

标签: vba excel-vba excel

我录制了以下宏:

Sub SGXdivdownload()
'
' SGXdivdownload Macro
'
    Sheets("K71U").Select
    Sheets("K71U").Name = "K71U"
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.sgxdata.pebbleslab.com/index.asp?m=2&NC=K71U", Destination:= _
        Range("$A$1"))
        .Name = "index.asp?m=2&NC=K71U"
        .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
    Rows("1:20").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 18
    ActiveWindow.ScrollRow = 21
    ActiveWindow.ScrollRow = 25
    ActiveWindow.ScrollRow = 28
    ActiveWindow.ScrollRow = 32
    ActiveWindow.ScrollRow = 36
    ActiveWindow.ScrollRow = 41
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 48
    ActiveWindow.ScrollRow = 52
    ActiveWindow.ScrollRow = 53
    ActiveWindow.ScrollRow = 56
    ActiveWindow.ScrollRow = 57
    ActiveWindow.ScrollRow = 58
    ActiveWindow.ScrollRow = 59
    ActiveWindow.ScrollRow = 60
    ActiveWindow.ScrollRow = 61
    ActiveWindow.ScrollRow = 62
    ActiveWindow.ScrollRow = 63
    ActiveWindow.ScrollRow = 64
    ActiveWindow.ScrollRow = 65
    ActiveWindow.ScrollRow = 66
    ActiveWindow.ScrollRow = 68
    ActiveWindow.ScrollRow = 69
    ActiveWindow.ScrollRow = 71
    ActiveWindow.ScrollRow = 72
    ActiveWindow.ScrollRow = 70
    ActiveWindow.ScrollRow = 69
    ActiveWindow.ScrollRow = 67
    ActiveWindow.ScrollRow = 66
    ActiveWindow.ScrollRow = 65
    ActiveWindow.ScrollRow = 62
    ActiveWindow.ScrollRow = 59
    ActiveWindow.ScrollRow = 56
    ActiveWindow.ScrollRow = 52
    ActiveWindow.ScrollRow = 48
    ActiveWindow.ScrollRow = 44
    ActiveWindow.ScrollRow = 41
    ActiveWindow.ScrollRow = 37
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 30
    ActiveWindow.ScrollRow = 26
    ActiveWindow.ScrollRow = 22
    ActiveWindow.ScrollRow = 19
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 1
    Columns("A:A").ColumnWidth = 17
End Sub

字符串“K71U”是工作表名称,宏应从每个工作表中读取此值,然后相应地调整宏。因此,如果选择了工作表XYZ并执行了宏,则应执行此宏:

Sub SGXdivdownload()
'
' SGXdivdownload Macro
'

'
    Sheets("XYZ").Select
    Sheets("XYZ").Name = "XYZ"
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;http://www.sgxdata.pebbleslab.com/index.asp?m=2&NC=XYZ", Destination:= _
        Range("$A$1"))
        .Name = "index.asp?m=2&NC=XYZ"
        .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
    Rows("1:20").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.ScrollRow = 2
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 18
    ActiveWindow.ScrollRow = 21
    ActiveWindow.ScrollRow = 25
    ActiveWindow.ScrollRow = 28
    ActiveWindow.ScrollRow = 32
    ActiveWindow.ScrollRow = 36
    ActiveWindow.ScrollRow = 41
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 48
    ActiveWindow.ScrollRow = 52
    ActiveWindow.ScrollRow = 53
    ActiveWindow.ScrollRow = 56
    ActiveWindow.ScrollRow = 57
    ActiveWindow.ScrollRow = 58
    ActiveWindow.ScrollRow = 59
    ActiveWindow.ScrollRow = 60
    ActiveWindow.ScrollRow = 61
    ActiveWindow.ScrollRow = 62
    ActiveWindow.ScrollRow = 63
    ActiveWindow.ScrollRow = 64
    ActiveWindow.ScrollRow = 65
    ActiveWindow.ScrollRow = 66
    ActiveWindow.ScrollRow = 68
    ActiveWindow.ScrollRow = 69
    ActiveWindow.ScrollRow = 71
    ActiveWindow.ScrollRow = 72
    ActiveWindow.ScrollRow = 70
    ActiveWindow.ScrollRow = 69
    ActiveWindow.ScrollRow = 67
    ActiveWindow.ScrollRow = 66
    ActiveWindow.ScrollRow = 65
    ActiveWindow.ScrollRow = 62
    ActiveWindow.ScrollRow = 59
    ActiveWindow.ScrollRow = 56
    ActiveWindow.ScrollRow = 52
    ActiveWindow.ScrollRow = 48
    ActiveWindow.ScrollRow = 44
    ActiveWindow.ScrollRow = 41
    ActiveWindow.ScrollRow = 37
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 30
    ActiveWindow.ScrollRow = 26
    ActiveWindow.ScrollRow = 22
    ActiveWindow.ScrollRow = 19
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 1
    Columns("A:A").ColumnWidth = 17
End Sub

感谢您的任何意见!

1 个答案:

答案 0 :(得分:1)

下面的宏根据所选的工作表名称请求数据:

Sub SGXdivdownload()
'
' SGXdivdownload Macro
'
    With ActiveSheet.QueryTables.Add("URL;http://www.sgxdata.pebbleslab.com/index.asp?m=2&NC=" & ActiveSheet.Name, Range("$A$1"))
        .Name = ActiveSheet.Name
        .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
    Rows("1:20").Select
    Selection.Delete Shift:=xlUp
    ActiveWindow.ScrollRow = 1
    Columns("A:A").ColumnWidth = 17
End Sub