如何从当前函数VBA Excel获取单元格行

Question

以下是VBA函数,该函数使用从开始月份和结束月份生成的一组唯一月份填充数组:

Function get_months(matrix_height As Integer) As Variant

    Worksheets("Analysis").Activate

    Dim date_range As String
    Dim column As String
    Dim uniqueMonths As Collection
    Set uniqueMonths = New Collection

    Dim dateRange As range
    Dim months_array() As String 'array for months

    column = Chr(64 + 1) 'A
    date_range = column & "2:" & column & matrix_height
    Set dateRange = range(date_range)

    On Error Resume Next

    Dim currentRange As range
    For Each currentRange In dateRange.Cells
        If currentRange.Value <> "" Then
            Dim tempDate As Date: tempDate = CDate(currentRange.Text) 'Convert the text to a Date
            Dim parsedDateString As String: parsedDateString = Format(tempDate, "MMM-yyyy")
            uniqueMonths.Add Item:=parsedDateString, Key:=parsedDateString
        End If
    Next currentRange

    On Error GoTo 0 'Enable default error trapping

    'Loop through the collection and view the unique months and years
    Dim uniqueMonth As Variant
    Dim counter As Integer
    counter = 0

    For Each uniqueMonth In uniqueMonths

        ReDim Preserve months_array(counter)
        months_array(counter) = uniqueMonth
        Debug.Print uniqueMonth
        counter = counter + 1

    Next uniqueMonth

    get_months = months_array

End Function

如何操作此函数以返回添加到我的月份数组的每个值的单元格行.

什么是存储这两个值的最佳方式,即日期(2011年10月)和行号(即456)

拖车阵列？然后返回一个包含这两个数组的数组？

任何人都可以提供这个问题的解决方案吗？

Answer 1

没有完全测试

我只是一个简单的例子,我认为这就是你想要的,让我知道你可能需要做的任何改变,我很乐意提供帮助.

这是草率和未完成的,但据我所知,工作在您的实际数据的副本而不是您的实际数据.当我有更多的时间,我可以尝试清理更多.

Function get_months(matrix_height As Integer) As Variant   
    Dim uniqueMonth As Variant
    Dim counter As Integer
    Dim date_range() As Variant
    Dim column As String
    Dim uniqueMonths As Collection
    Dim rows As Collection
    Set uniqueMonths = New Collection
    Set rows = New Collection

    Dim dateRange As Range
    Dim months_array() As String 'array for months

    date_range = Worksheets("Analysis").Range("A2:A" & matrix_height + 1).Value

    On Error Resume Next

    For i = 1 To matrix_height 
        If date_range(i, 1) <> "" Then
            Dim parsedDateString As String: parsedDateString = Format(date_range(i, 1), "MMM-yyyy")
            uniqueMonths.Add Item:=parsedDateString, Key:=parsedDateString
            If Err.Number = 0 Then rows.Add Item:=i + 1
            Err.Clear
        End If
    Next i

    On Error GoTo 0 'Enable default error trapping

    'Loop through the collection and view the unique months and years
    ReDim months_array(uniqueMonths.Count, 2)

    For y = 1 To uniqueMonths.Count 
        months_array(y, 1) = uniqueMonths(y)
        months_array(y, 2) = rows(y)
    Next y

    get_months = months_array

End Function

可以这样称呼:

Sub CallFunction()
Dim y As Variant

y = get_months(WorksheetFunction.Count([A:A]) - 1)

End Sub