2

以下は、開始月と終了月から生成された一意の月のセットを配列に入力する 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

この関数を操作して、月の配列に追加される各値のセル行を返すにはどうすればよいですか。

これらの 2 つの値、つまり日付 (2011 年 10 月) と行番号 (つまり 456) を格納する最良の方法は何でしょうか。

トウアレイ？次に、これら 2 つの配列を含む配列を返しますか?

誰でもこの問題の解決策を提供できますか?

4

2 に答える 2

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
于 2013-09-26T15:59:48.240 に答える