Question

我一直在尝试创建一个表格，该表格会自动为用户指定的特定时期提供一系列汇率。我遇到this article，我发现它非常有用，我一直在努力扩展VBA代码以包含多种货币转换。但是，我无法弄清楚如何执行此操作并且遇到以下错误：

错误1004：Microsoft Office Excel只能转换一个列时间。范围可以是多行高但不超过一列宽。再次选择一列中的单元格再试一次。

请您查看下面的代码并帮我解决错误，以便获得多种货币转换？非常感谢提前。

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)

Answer 1

您是否在C＆amp;列中有原始数据？ d？如果是这样，您可能需要以不同方式组织它们，或者将两者连接到C中，用逗号分隔它们（因为这是此处使用的分隔符），或者将数据放在列d中的另一行中。然后你需要摆脱：

.CurrentRegion

后

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

Answer 2

根据Microsoft Developer Network;

中的文档

当前区域是由空行的任意组合限定的范围和空白列。

鉴于您的代码Sheets("GBP").Range("C5").CurrentRegion ...

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

要解决此问题，您需要确保空白行和列中的单元格区域只有一列。

Excel VBA - 下载多个历史汇率

2 个答案: