[英]Excel VBA Reverse Selected Cells
我的工作簿中的宏中有以下位。 它选择最后 n=10 行设置为数据源。
.lstDbase.RowSource = "Stencils!A" & iRow - 10 & ":R" & iRow
我是否能够在不实际保存反转数据的情况下反转此选择?
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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.