Excel VBA – 下载多个历史汇率

我一直在试图创build一个表,自动提供一个由用户指定的给定期间的汇率范围。 我遇到这篇文章 ,我发现非常有用,我一直在试图扩大VBA代码,以包括多种货币转换。 然而,我一直无法弄清楚如何做到这一点,并坚持以下错误:

错误1004:Microsoft Office Excel一次只能转换一列。 范围可以是多行高但不超过一列宽。 只能在一列中select单元格再试一次。

你能看看我的代码在下面,并帮助我解决这个错误,以便我可以获得多种货币转换? 提前谢谢了。

Sub GetData() Dim DataSheet As Worksheet Dim endDate As String Dim startDate As String Dim str As String Dim LastRow As Integer Sheets("GBP").Cells.Clear Set DataSheet = ActiveSheet startDate = DataSheet.Range("startDate").Value endDate = DataSheet.Range("endDate").Value ' GBP/EUR str = "http://www.oanda.com/currency/historical-rates/download?quote_currency=" _ & "GBP" _ & "&end_date=" _ & Year(endDate) & "-" & Month(endDate) & "-" & Day(endDate) _ & "&start_date=" _ & Year(startDate) & "-" & Month(startDate) & "-" & Day(startDate) _ & "&period=daily&display=absolute&rate=0&data_range=c&price=bid&view=table&base_currency_0=" _ & "EUR" _ & "&base_currency_1=&base_currency_2=&base_currency_3=&base_currency_4=&download=csv" With Sheets("GBP").QueryTables.Add(Connection:="URL;" & str, Destination:=Sheets("GBP").Range("A1")) .BackgroundQuery = True .TablesOnlyFromHTML = False .Refresh BackgroundQuery:=False .SaveData = True End With Sheets("GBP").Range("A5").CurrentRegion.TextToColumns Destination:=Sheets("GBP").Range("A5"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, other:=True, OtherChar:=",", FieldInfo:=Array(1, 2) Sheets("GBP").Columns("A:B").ColumnWidth = 12 Sheets("GBP").Range("A1:B2").Clear LastRow = Sheets("GBP").UsedRange.Row - 6 + Sheets("GBP").UsedRange.Rows.Count Sheets("GBP").Range("A" & LastRow + 2 & ":B" & LastRow + 5).Clear ' GBP/USD str = "http://www.oanda.com/currency/historical-rates/download?quote_currency=" _ & "GBP" _ & "&end_date=" _ & Year(endDate) & "-" & Month(endDate) & "-" & Day(endDate) _ & "&start_date=" _ & Year(startDate) & "-" & Month(startDate) & "-" & Day(startDate) _ & "&period=daily&display=absolute&rate=0&data_range=c&price=bid&view=table&base_currency_0=" _ & "USD" _ & "&base_currency_1=&base_currency_2=&base_currency_3=&base_currency_4=&download=csv" With Sheets("GBP").QueryTables.Add(Connection:="URL;" & str, Destination:=Sheets("GBP").Range("C1")) .BackgroundQuery = True .TablesOnlyFromHTML = False .Refresh BackgroundQuery:=False .SaveData = True End With Sheets("GBP").Range("C5").CurrentRegion.TextToColumns Destination:=Sheets("GBP").Range("C5"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, other:=True, OtherChar:=",", FieldInfo:=Array(1, 2) Sheets("GBP").Columns("C:D").ColumnWidth = 12 Sheets("GBP").Range("C1:D2").Clear LastRow = Sheets("GBP").UsedRange.Row - 6 + Sheets("GBP").UsedRange.Rows.Count Sheets("GBP").Range("C" & LastRow + 2 & ":D" & LastRow + 5).Clear End Sub 

错误发生在以下行:

 Sheets("GBP").Range("C5").CurrentRegion.TextToColumns Destination:=Sheets("GBP").Range("C5"), DataType:=xlDelimited, _ TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _ Semicolon:=False, Comma:=True, Space:=False, other:=True, OtherChar:=",", FieldInfo:=Array(1, 2) 

你们有C&D专栏的原始数据吗? 如果是这样,你可能需要以不同的方式来组织它们,或者用逗号将它们连接成C来分隔它们(因为这是在这里使用的分隔符),或者将列d中的数据放在c列的另一行中。 那么你将需要摆脱:

 .CurrentRegion 

 Sheets("GBP").Range("C5") 

根据Microsoft Developer Network中的文档;

当前区域是以空白行和空白列的任意组合为界的范围。

考虑到你的代码Sheets("GBP").Range("C5").CurrentRegion

这意味着findSheets("GBP").Range("C5")上方和下方的第一个空白行Sheets("GBP").Range("C5") 。 然后findSheets("GBP").Range("C5")左侧和右侧的第一个空白栏Sheets("GBP").Range("C5") 。 这些空白行和列中的所有内容都将成为您的CurrentRegion 。 如果这是多个列,你会得到你得到的错误。

为了解决这个问题,你需要确保空白行和列内的单元格区域只有一列。