Excel 合并单元格的数据表进行排序

由于公司需要统计人数并且排序。但是由于表格设置的问题,里面有合并单元格,不能直接处理。

如下图数据,希望按合计人数进行升序排列。这里我们用VBA代码去处理

源数据:

详细VBA代码:

Sub sortMerge()

Dim i As Integer

Dim j As Integer

Dim k As Integer

Dim ArrTemp() As Long

Dim ArrSort() As Long

Application.ScreenUpdating = False

i = 2

ReDim ArrTemp(1 To 4, 1 To 1)

'    以下循环将A列中各合并单元格的起始行号和终止行号保存在数组ArrTemp的第一行和第二行相应项目中,

'    同时在数组ArrTemp的第三行中写入排序标志项的内容(即各人数合计单元数值);

Do While Cells(i, 1) <> ''

k = k 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

'    以下双循环通过比较标志项的方法,在数组的第4行中保存各标志项数值在所有数值中的大小顺序,

'    此处填入的数据为所有标志项数值中小于相应标志项数值的个数

For i = 1 To k - 1

For j = i 1 To k

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)

'    以下循环根据数组ArrTemp中第4行的数值按升序调整各合并单元格始末位置的顺序

For i = 1 To k

ArrSort(ArrTemp(4, i) 1, 1) = ArrTemp(1, i)

ArrSort(ArrTemp(4, i) 1, 2) = ArrTemp(2, i)

Next i

'    以下循环按数组ArrSort的顺序复制相应行到原数据列表的下面

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

End Sub

运行效果图:

参考至:小智雅汇(头条号)

(0)

相关推荐