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

下面是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数组的值的单元格行。

什么是最好的方式来存储这两个值，即date（2011年10月）和行号（即456）

拖arrays？ 然后返回一个包含这两个数组的数组？

任何人都可以提供解决这个问题？

Answer 1

没有完全testing

我只是一个简单的例子，我认为这是你正在寻找的，让我知道你可能需要的任何改变，我会很乐意提供帮助。

这是马虎，未完成，但工作，据我所知，testing在您的实际数据的副本，而不是在您的实际数据。 当我得到更多的时间，我可以尝试清理更多。

 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：

 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