这是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
如何操作此函数以返回添加到我的月份数组中的每个值的单元格行。
存储这两个值的最佳方法是什么,即The Date(Oct-2011)&amp;行号(即456)
拖车阵列?然后返回一个包含这两个数组的数组?
任何人都可以提供这个问题的解决方案吗?
答案 0 :(得分:5)
未完全测试
我只是一个快速的例子,我认为这就是你想要的,让我知道你可能需要做的任何改变,我很乐意提供帮助。
这是草率和未完成但据我所知,在您的实际数据的副本中测试,而不是在您的实际数据上。当我有更多的时间,我可以尝试清理更多。
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
答案 1 :(得分:0)
功能:
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