我创建了一个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