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