如何從當前函數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 

如何操作此函數返回要添加到我的months數組中的每個值的單元格行。

什麼是存儲這兩個值即日期（OCT-2011）&行號（即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