0

我一直在尝试创建一个表，该表自动提供用户指定的给定期间的汇率范围。我发现这篇文章非常有用，我一直在尝试扩展 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)
4

2 回答 2

1

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

.CurrentRegion

后

Sheets("GBP").Range("C5")
于 2013-07-25T16:34:51.357 回答
1

根据Microsoft Developer Network中的文档；

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

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

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

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

于 2013-07-25T17:14:54.223 回答