如何从当前函数 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

Answer 2

功能：

Function get_months() As Variant

    Dim UnqMonths As Collection
    Dim ws As Worksheet
    Dim rngCell As Range
    Dim arrOutput() As Variant
    Dim varRow As Variant
    Dim strRows As String
    Dim strDate As String
    Dim lUnqCount As Long
    Dim i As Long

    Set UnqMonths = New Collection
    Set ws = Sheets("Analysis")

    On Error Resume Next
    For Each rngCell In ws.Range("A2", ws.Cells(Rows.Count, "A").End(xlUp)).Cells
        If IsDate(rngCell.Text) Then
            strDate = Format(CDate(rngCell.Text), "mmm-yyyy")
            UnqMonths.Add strDate, strDate
            If UnqMonths.Count > lUnqCount Then
                lUnqCount = UnqMonths.Count
                strRows = strRows & " " & rngCell.Row
            End If
        End If
    Next rngCell
    On Error GoTo 0

    If lUnqCount > 0 Then
        ReDim arrOutput(1 To lUnqCount, 1 To 2)
        For i = 1 To lUnqCount
            arrOutput(i, 1) = UnqMonths(i)
            arrOutput(i, 2) = Split(strRows, " ")(i)
        Next i
    End If

    get_months = arrOutput

End Function

调用和输出：

Sub tgr()

    Dim my_months As Variant

    my_months = get_months

    With Sheets.Add(After:=Sheets(Sheets.Count))
        .Range("A2").Resize(UBound(my_months, 1), UBound(my_months, 2)).Value = my_months
        With .Range("A1:B1")
            .Value = Array("Unique Month", "Analysis Row #")
            .Font.Bold = True
            .EntireColumn.AutoFit
        End With
    End With

End Sub