|
楼主 |
发表于 2024-1-6 09:42
|
显示全部楼层
按思路二,想生成辅助列,导入到S列里,但没成功,肯定是写错了
- Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
- Dim r%, c%, r1%, c1%
- Dim m%, i%
- Application.ScreenUpdating = False
- Application.DisplayAlerts = False
- Application.EnableEvents = False
-
- With ActiveSheet
- '本表
- r = .Cells(.Rows.Count, 1).End(xlUp).Row
- c = .Cells(1, .Columns.Count).End(xlToLeft).Column
- '鼠标选定的单元格
- r1 = Target.Row
- c1 = Target.Column
- If r1 > 1 And r1 <= r And c1 > 1 And c1 < c Then
- arr = .Range("a1").Resize(r, c)
- '-------------------------------------------------------------------按思路二,添加辅助列
- m = Application.Max(Application.Index(arr, 0, c))
- 'ReDim crr(1 To r, 1 To 1)
- For i = 1 To UBound(arr)
- If Len(arr(i, c1)) > 0 Then
- Cells(i, c + 1) = Cells(i, c) + m
- Else
- Cells(i, c + 1) = Cells(i, c)
- End If
- Next
- '-------------------------------------------------------------------
-
- '多标准排序
- '先按双击的【单元格所在的列】排【降序】
- '再按【最右列】排【降序】
- ' .Range("a1").Resize(r, c).Sort _
- key1:=.Cells(1, c), order1:=xlDescending, _
- key2:=.Cells(1, c1), order2:=xlDescending, Header:=xlYes
- '跳出编辑状态
- Target.Offset(-(r1 - 2), 0).Select
- End If
- End With
- Application.ScreenUpdating = True
- Application.DisplayAlerts = True
- Application.EnableEvents = True
- End Sub
复制代码
|
|