Excel VBA 反向選擇單元格

Question

我的工作簿中的宏中有以下位。 它選擇最后 n=10 行設置為數據源。

.lstDbase.RowSource = "Stencils!A" & iRow - 10 & ":R" & iRow

我是否能夠在不實際保存反轉數據的情況下反轉此選擇？

Answer 1

反向獲取范圍行

Option Explicit

Sub PopulateRangeRowsReverse() ' ???
    
    Const fRow As Long = 2 ' ???
    Const rMaxOffset As Long = 10
    'Const iRow As Long = 11 ' ???
        
    'With ??? 
        
        Dim lrCount As Long: lrCount = iRow - fRow + 1
        If lrCount < 1 Then Exit Sub ' no data
        
        If lrCount > rMaxOffset Then lrCount = rMaxOffset
    
        Dim rg As Range
        Set rg = ThisWorkbook.Worksheets("Stencils") _
            .Rows(iRow - lrCount + 1).Columns("A:R").Resize(lrCount)
    
        Dim Data As Variant: Data = GetRangeRowsReverse(rg)
    
        With .lstDbase
            .Clear
            .ColumnCount = rg.Columns.Count
            .List = Data
        End With

    'End With

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Purpose:      Returns the reversed rows of a range in a 2D one-based array.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function GetRangeRowsReverse( _
    ByVal rg As Range) _
As Variant
    Const ProcName As String = "GetRangeRowsReverse"
    On Error GoTo ClearError
    
    Dim sData As Variant
    Dim rCount As Long
    Dim cCount As Long
    
    With rg
        rCount = .Rows.Count
        cCount = .Columns.Count
        If rCount + cCount = 2 Then
            ReDim sData(1 To 1, 1 To 1): sData(1, 1) = .Value
        Else
            sData = .Value
        End If
    End With
    
    Dim dData As Variant: ReDim dData(1 To rCount, 1 To cCount)
    
    Dim r As Long
    Dim c As Long
    
    For r = 1 To rCount
        For c = 1 To cCount
            dData(r, c) = sData(rCount, c)
        Next c
        rCount = rCount - 1
    Next r
    
    GetRangeRowsReverse = dData
    
ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "' Run-time error '" _
        & Err.Number & "':" & vbLf & "    " & Err.Description
    Resume ProcExit
End Function