按VBA中的日期排序

时间:2015-08-14 14:08:25

标签: excel vba excel-vba

我创建了一个VBA函数,用于从外部源中选择数据并将其插入到Excel工作表中。我希望能够按日期排序,最新日期出现在列表中的第一位。我不知道如何将这个函数(或要添加的函数)添加到我现有的函数中,以便它继续循环。

Sub getDividends()

    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim EndDate As Date
    Dim StartDate As Date
    Dim Symbol As String
    Dim qurl As String
    Dim nQuery As Name

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Set DataSheet = ActiveSheet

    StartDate = DataSheet.Range("B2").Value
    EndDate = DataSheet.Range("B3").Value
    Symbol = DataSheet.Range("B4").Value
    Range("C7").CurrentRegion.ClearContents

'construct the URL for the query

    qurl = "http://ichart.finance.yahoo.com/table.csv?s=" & Symbol
    qurl = qurl & "&a=" & Month(StartDate) & "&b=" & Day(StartDate) & _
        "&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
        Day(EndDate) & "&f=" & Year(EndDate) & "&g=v&ignore=.csv"
        Range("e1") = qurl

QueryQuote:
         With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7"))
            .BackgroundQuery = True
            .TablesOnlyFromHTML = False
            .Refresh BackgroundQuery:=False
            .SaveData = True
        End With

        Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=True, Space:=False, other:=False

        Range(Range("C7"), Range("C7").End(xlDown)).NumberFormat = "mmm d, yyyy"
        Range(Range("D7"), Range("G7").End(xlDown)).NumberFormat = "$0.00"


With ThisWorkbook
    For Each nQuery In Names
        If IsNumeric(Right(nQuery.Name, 1)) Then
            nQuery.Delete
        End If
    Next nQuery
End With

'turn calculation back on
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Range("C8:D500").Select
Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("C1").Select
Selection.ColumnWidth = 17.7

getPrice

Range("B4").Select

End Sub

Sub getPrice()

    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim qurl As String
    Dim i As Integer

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Set DataSheet = ActiveSheet

Range("A7").CurrentRegion.ClearContents

qurl = "http://download.finance.yahoo.com/d/quotes.csv?s=" + Range("B4") + "&f=l1"

QueryQuote:
         With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("A7"))
            .BackgroundQuery = True
            .TablesOnlyFromHTML = False
            .Refresh BackgroundQuery:=False
            .SaveData = True
        End With

        Range("A7").CurrentRegion.TextToColumns Destination:=Range("A7"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=True, Space:=False, other:=False


'turn calculation back on
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Range("A1").Select
Selection.ColumnWidth = 20

End Sub

Sub getaLL()

    Dim i As Integer, j As Integer, n As Integer

    n = Range("E3")
    j = 9

Range("I2").CurrentRegion.ClearContents
Range("A5") = "Retrieving Dividends ..."
For i = 1 To n

Range("B4") = Cells(1 + i, 7)
getDividends
Cells(1, j) = Range("C5")

Range("C7:D500").Select
Selection.Copy
Cells(2, j).Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=False
Selection.ColumnWidth = 12

j = j + 2
Next i

Range("A5").Select
Selection.ClearContents
End Sub

0 个答案:

没有答案
相关问题