Excel工作表单元格单击选中事件，VBA动态数值排序

Excel工作表单元格单击选中事件，VBA动态数值排序（WX公众号：Excel潘谆白说VBA)

---

前言

面对每月的消费账单，面对月底待还的信用卡或花呗，面对不足三位数的余额，你是否怀疑过账单自己的消费。你是否因此开始记账，每个月记流水,想知道当月中消费金额哪项最多，哪项最少;
你是一名会计，只想用粗略的查看某个月、某个科目下或某个客户经济往来的的变化趋势;
你是一名行政人员，想了解一下每个月某个员工迟到、旷工、加班情况，或当月所有员工迟到、旷工、加班排序;
你是仓库保管人员，想查看某种类的货物当年进、出量排序……
不需要筛选、汇总、计算，只要点击所查单元格，VBA快速帮你排列顺序。

---

一、运行效果

Excel工作表单元格单击选中事件，VBA动态数值排序

二、代码

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Dim str As String
  Dim targetUsedRow As Integer
  Dim targetUsedCol As Integer
  Dim sumTarget As String
  Dim sumAll As Integer
  Dim arrA() As Integer
  Dim tmp1 As Integer
  Dim tmp2 As String
  On Error Resume Next
  ActiveSheet.Range("A1:IV65536").Interior.ColorIndex = xlNone
  str = ActiveSheet.Cells(Target.Row, Target.Column).Value
  For i = 1 To 65536         '计算行数
    If ActiveSheet.Cells(i, Target.Column).Value = "" Then
      targetUsedRow = i - 1
      Exit For
    End If
  Next
  For i = 1 To 65536         '计算行数
    If ActiveSheet.Cells(1, i).Value = "" Then
      targetUsedCol = i - 1
      Exit For
  End If
  Next
  If str = "" Or Target.Column > 2 Then  '若选中单元格为空白或超范围，退出触发事件
    Exit Sub
  End If
  For i = 2 To targetUsedRow   '清空单元格
    For j = 5 To 7
    Cells(i, j).Value = ""
    Next
  Next
  ActiveSheet.Columns("E:E").ColumnWidth = 10
  ActiveSheet.Columns("F:F").ColumnWidth = 20
  ReDim arrA(targetUsedRow, 2)
  For i = 2 To targetUsedRow
    If str <> "" And ActiveSheet.Cells(i, Target.Column).Value = str Then
      ActiveSheet.Cells(i, Target.Column).Interior.ColorIndex = 44
      ActiveSheet.Cells(Target.Row, Target.Column).Interior.ColorIndex = 44
      sumTarget = Cells(i, 3).Value
      arrA(m, 0) = sumTarget
      arrA(m, 1) = i
      m = m + 1
    End If
  Next
  If m > 0 Then                  '冒泡排序法
   For j = m To 1 Step -1
    For i = 1 To j
      If arrA(i - 1, 0) < arrA(i, 0) Then
        tmp1 = arrA(i, 0)
        arrA(i, 0) = arrA(i - 1, 0)
        arrA(i - 1, 0) = tmp1
        tmp2 = arrA(i, 1)
        arrA(i, 1) = arrA(i - 1, 1)
        arrA(i - 1, 1) = tmp2
      End If
     Next
    Next
      ActiveSheet.Cells(1, targetUsedCol + 2) = "时间"
      ActiveSheet.Cells(1, targetUsedCol + 3) = "消费类别"
      ActiveSheet.Cells(1, targetUsedCol + 4) = "金额"
    For i = 0 To m
      ActiveSheet.Cells(i + 2, targetUsedCol + 2) = ActiveSheet.Cells(arrA(i, 1), 1).Value
      ActiveSheet.Cells(i + 2, targetUsedCol + 3) = ActiveSheet.Cells(arrA(i, 1), 2).Value
      ActiveSheet.Cells(i + 2, targetUsedCol + 4) = ActiveSheet.Cells(arrA(i, 1), 3).Value
    Next
  End If
End Sub