VBA实现年份及年份范围转年份列表的技术问询

Got it, let's build out your code to handle year ranges, validate inputs, and output a clean list to your worksheet. Here's a complete, commented solution that picks up where you left off:

Sub customYearList()
    Dim customListEntry As String
    Dim splitEntries As Variant
    Dim entry As String
    Dim yearParts As Variant
    Dim startYear As Integer, endYear As Integer
    Dim validYears As Object ' Late-bound Scripting.Dictionary
    Dim i As Integer
    Dim invalidEntries As String
    
    ' Initialize dictionary to store unique valid years
    Set validYears = CreateObject("Scripting.Dictionary")
    invalidEntries = ""
    
    ' Get user input
    customListEntry = InputBox("Enter list of years (comma-separated, e.g., 1946, 1948-1954):")
    
    ' Exit if user cancels input
    If customListEntry = "" Then Exit Sub
    
    ' Split input into individual entries
    splitEntries = Split(customListEntry, ",")
    
    ' Process each entry
    For Each entry In splitEntries
        entry = Trim(entry) ' Remove leading/trailing whitespace
        
        ' Skip empty entries (in case of double commas)
        If entry = "" Then GoTo NextEntry
        
        ' Check if entry is a year range (contains hyphen)
        If InStr(entry, "-") > 0 Then
            yearParts = Split(entry, "-")
            
            ' Validate range has exactly two parts
            If UBound(yearParts) <> 1 Then
                invalidEntries = invalidEntries & entry & ", "
                GoTo NextEntry
            End If
            
            ' Check both parts are valid years
            If IsNumeric(yearParts(0)) And IsNumeric(yearParts(1)) Then
                startYear = CInt(yearParts(0))
                endYear = CInt(yearParts(1))
                
                ' Ensure start year is <= end year and within reasonable range
                If startYear >= 1900 And endYear <= 2100 And startYear <= endYear Then
                    ' Add all years in the range to the dictionary (auto-handles duplicates)
                    For i = startYear To endYear
                        validYears(i) = True
                    Next i
                Else
                    invalidEntries = invalidEntries & entry & ", "
                End If
            Else
                invalidEntries = invalidEntries & entry & ", "
            End If
        Else
            ' Check if entry is a single valid year
            If IsNumeric(entry) Then
                startYear = CInt(entry)
                If startYear >= 1900 And startYear <= 2100 Then
                    validYears(startYear) = True
                Else
                    invalidEntries = invalidEntries & entry & ", "
                End If
            Else
                invalidEntries = invalidEntries & entry & ", "
            End If
        End If
        
NextEntry:
    Next entry
    
    ' Notify user of invalid entries (if any)
    If invalidEntries <> "" Then
        MsgBox "Skipped invalid entries: " & Left(invalidEntries, Len(invalidEntries) - 2)
    End If
    
    ' Write valid years to worksheet (starting at A1, sorted in ascending order)
    If validYears.Count > 0 Then
        ' Convert dictionary keys to sorted array
        Dim sortedYears As Variant
        sortedYears = validYears.Keys
        Call BubbleSort(sortedYears) ' Sort the array
        
        ' Write to worksheet (column A starting at row 1)
        Range("A1").Resize(UBound(sortedYears) + 1, 1).Value = Application.Transpose(sortedYears)
        
        MsgBox "Successfully wrote " & validYears.Count & " valid years to the worksheet!"
    Else
        MsgBox "No valid years found in input."
    End If
    
    ' Cleanup
    Set validYears = Nothing
End Sub

' Helper function to sort the year array (ascending order)
Sub BubbleSort(arr As Variant)
    Dim i As Integer, j As Integer
    Dim temp As Variant
    
    For i = LBound(arr) To UBound(arr) - 1
        For j = i + 1 To UBound(arr)
            If arr(i) > arr(j) Then
                temp = arr(i)
                arr(i) = arr(j)
                arr(j) = temp
            End If
        Next j
    Next i
End Sub

Key Features Explained: #

• Input Handling: Trims whitespace and skips empty entries from the input string to avoid errors.
• Range Expansion: Splits hyphen-separated ranges (like 1950-1954) and adds every year in between to the final list.
• Validation: Checks that years fall within a reasonable 1900-2100 range — adjust these values if you need to support earlier/later years.
• Uniqueness: Uses a Scripting.Dictionary to automatically remove duplicate years, so you don't get repeated entries even if the user inputs the same year multiple times.
• Sorting: Includes a simple bubble sort helper to output years in ascending order for readability.
• User Feedback: Notifies you of any invalid entries (like cat or dog) that were skipped, and confirms when valid years are written to the sheet.

Customization Tips: #

• To change where the years are written, modify Range("A1") to your target cell (e.g., Range("C5")).
• To output years in a row instead of a column, remove Application.Transpose and adjust the resize: Range("A1").Resize(1, UBound(sortedYears) + 1).Value = sortedYears.
• Tweak the year range (1900 and 2100) in the validation checks to match your specific needs.

内容的提问来源于stack exchange，提问作者Adam