是否可以从通用Sub创建一个函数?

时间:2014-02-25 11:16:19

标签: function vba excel-vba excel

在我的Excel工作表中,存在一个Button(表单控件),与之相关的VBA代码如下:

Sub Import()

    Sheets("Import").Cells.ClearContents

    With Sheets("Import").QueryTables.Add(Connection:= _
        "TEXT;C:\...\my_file.csv" _
        , Destination:=Sheets("Import").Range("$A$1"))
        .Name = "my_file"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    ticker = Sheets("Curve").Range("E1").Value
    tickerCorrected = Replace(ticker, " by", "")
    lastRow = Sheets("Import").Cells(Sheets("Import").Rows.Count, "B").End(xlUp).Row

    For i = 1 To lastRow
        If Sheets("Import").Range("B" & i).Value = tickerCorrected Then
            If Sheets("Import").Range("D" & i).Value = 0.5 Then
                Sheets("Curve").Range("K4:K11").Value = Sheets("Import").Range("C" & i & ":C" & i + 7).Value
            End If
        End If
    Next

End Sub

当然上面的宏所做的并不重要,请考虑它只是一个通常你不会分配给函数的例子。

我尝试创建一个执行上述指令的函数并返回Boolean

Public Function Importfn(ticker As String) As Boolean

    Sheets("Import").Cells.ClearContents

    With Sheets("Import").QueryTables.Add(Connection:= _
        "TEXT;C:\...\my_file.csv" _
        , Destination:=Sheets("Import").Range("$A$1"))
        .Name = "my_file"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = True
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With

    ticker = Sheets("Curve").Range("E1").Value
    tickerCorrected = Replace(ticker, " by", "")
    lastRow = Sheets("Import").Cells(Sheets("Import").Rows.Count, "B").End(xlUp).Row

    For i = 1 To lastRow
        If Sheets("Import").Range("B" & i).Value = tickerCorrected Then
            If Sheets("Import").Range("D" & i).Value = 0.5 Then
                Sheets("Curve").Range("K4:K11").Value = Sheets("Import").Range("C" & i & ":C" & i + 7).Value
            End If
        End If
    Next

    Importfn = True

End Function

这不会返回任何错误。

问题:

  1. 实际上可以做出这样的功能吗?
  2. 对于分配给表单而不是函数内的Sub,您可以做些什么吗?
  3. 我应该修改哪些功能才能使其正常工作?

0 个答案:

没有答案