技巧108 包含合并单元格的数据列表排序

  • 格式:xls
  • 大小:36.00 KB
  • 文档页数:1

用工单位派工单位人数计件量A公司
332658B公司11753C公司
261919合计
705330B公司
937905C公司
292204合计
12210109A公司
816642C公司
191710合计
1008352C公司554730合计554730
甲公司乙公司丙公司丁公司执行代码
Sub SortMerge()
Dim i As Integer, j As Integer, k As Integer
Dim ArrTemp() As Long, ArrSort() As Long
Application.ScreenUpdating = False '禁止屏幕刷新
i = 2 '初始化变量i
ReDim ArrTemp(1 To 4, 1 To 1) '定义数组ArrTemp 为两维数组Do While Cells(i, 1) <> "" '将相关数据读入数组
k = k + 1 '变量加1
ReDim Preserve ArrTemp(1 To 4, 1 To k) '重定义数组,保存原数组ArrTemp(1, k) = i '保存合并单元格起始行
i = i + Cells(i, 1).MergeArea.Cells.Count '下一记录起始行ArrTemp(2, k) = i - 1 '保存合并单元格结束行ArrTemp(3, k) = Cells(i -1, 3) '记录排序标志项
Loop
For i = 1 To k - 1 '按排序标志项对数据排序
For j = i + 1 To k '序号放在ArrTemp(4,i)中
If ArrTemp(3, i) > ArrTemp(3, j) Then
ArrTemp(4, i) = ArrTemp(4, i) + 1
Else
ArrTemp(4, j) = ArrTemp(4, j) + 1
End If
Next j
Next i
ReDim ArrSort(1 To k, 1 To 2)
For i = 1 To k '排好序后整理到ArrSort
ArrSort(ArrTemp(4, i) + 1, 1) = ArrTemp(1, i)
ArrSort(ArrTemp(4, i) + 1, 2) = ArrTemp(2, i)
Next i
For i = k To 1 Step -1 '从后向前进行排序
Rows(ArrSort(i, 1) & ":" & ArrSort(i, 2)).Copy
Rows(ArrTemp(2, k) + 1).Insert Shift:=xlDown
Next i
Rows("2:" & ArrTemp(2, k)).Delete
Application.ScreenUpdating = True。