将范围传递给功能

时间:2016-06-07 16:38:36

标签: function excel-vba range parameter-passing vba

我有以下代码,我用它来修改查询的命令文本。 问题出在我试图传递范围的最后一行(RepStartRng)。我的代码不是传递范围地址,而是传递范围值。请参阅下文并提前致谢。

Sub UseClass()
    Dim c As Report_
    Set c = New Report_

    Dim RepC As Long
    Dim Repcol As String
    Dim Counter As Long
    Dim RepStartRng As Range

    c.Day = FindDay()
    Repcol = ColLetter(FindDay())
    RepC = CountReports(Repcol)
    c.name = "A"
    Debug.Print "Repcol: " & Repcol
    Debug.Print RepC
    c.RepCount = RepC
    For i = 1 To c.RepCount
        Counter = i
        Report = Rep(Counter, ColLetter(FindDay()))
        Set RepStartRng = Range(Repcol & "3")
        RepStartRng.Select
        Debug.Print RepStartRng.Address
        UpdateQuery Report, RepStartRng, Counter
    Next i
End Sub
Function UpdateQuery(Report As String, RepRng As Range, Counter As Long)
    Dim Rng As Range
    Set RepRng = RepRng
    Dim Dat As String
    Dat = QueryDates(Rng)
    Dim cn As WorkbookConnection
    Dim wb As Workbook
    Dim NewWb As Workbook
    Set wb = ActiveWorkbook

    Dim odbcCn As ODBCConnection, oledbCn As OLEDBConnection
    For Each cn In ThisWorkbook.Connections
        If cn.name = Report Then
            Set oledbCn = cn.OLEDBConnection
            Debug.Print Dat
            oledbCn.CommandText = Replace(oledbCn.CommandText, "?", "'" & Dat & "'")
            Sheets(Rng.Value).Copy
            Set NewWb = ActiveWorkbook
            NewWb.SaveAs ("C:\Users\krishn.patel\Desktop\" & Rng.Value & ".xlsb"), FileFormat:=50
            NewWb.Close
            oledbCn.CommandText = Replace(oledbCn.CommandText, "'" & Dat & "'", "?")
        End If
    Next
End Function

1 个答案:

答案 0 :(得分:0)

在不知道您的范围内容或查看您调用的其他功能(例如QueryDates)的情况下,无法知道此代码是否完美,但它应该让您更接近您需要的内容。我删除了冗余变量并将函数更改为Sub,因为它没有返回任何值。

Sub UseClass()
    Dim c As Report_
    Set c = New Report_

    Dim RepC As Long
    Dim Repcol As String
    Dim Counter As Long
    Dim RepStartRng As Range

    c.Day = FindDay()
    Repcol = ColLetter(FindDay())
    RepC = CountReports(Repcol)
    c.name = "A"
    Debug.Print "Repcol: " & Repcol
    Debug.Print RepC
    c.RepCount = RepC
    For Counter = 1 To c.RepCount
        Report = Rep(Counter, ColLetter(FindDay()))
        Set RepStartRng = Range(Repcol & "3")
        UpdateQuery Report, RepStartRng, Counter
    Next Counter
End Sub
Sub UpdateQuery(Report As String, RepRng As Range, Counter As Long)
    Dim Dat As String
    Dat = QueryDates(RepRng)
    Dim cn As WorkbookConnection
    Dim NewWb As Workbook

    Dim odbcCn As ODBCConnection, oledbCn As OLEDBConnection
    For Each cn In ThisWorkbook.Connections
        If cn.name = Report Then
            Set oledbCn = cn.OLEDBConnection
            Debug.Print Dat
            oledbCn.CommandText = Replace(oledbCn.CommandText, "?", "'" & Dat & "'")
            Sheets(RepRng.Value).Copy
            Set NewWb = ActiveWorkbook
            NewWb.SaveAs ("C:\Users\krishn.patel\Desktop\" & RepRng.Value & ".xlsb"), FileFormat:=50
            NewWb.Close
            oledbCn.CommandText = Replace(oledbCn.CommandText, "'" & Dat & "'", "?")
        End If
    Next
End Sub