Excel应用实践18：按照指定工作表中的数据顺序对另一工作表中的数据排序

学习Excel技术，关注微信公众号：

excelperfect

我从数据库中导入数据到工作表，本来数据库中的数据顺序是排好了的，然而导入工作表中后数据顺序变乱了。如果在工作表中使用复制粘贴来重新恢复固定的顺序，将会花费大量的时间，能否使用VBA快速完成排序，详情如下。

下图1中“固定顺序”工作表为数据本来应该的顺序：

图1

图2中“整理前”工作表为导入数据后的顺序：

图2

可以看出，“整理前”工作表中的列顺序被打乱了，我们需要根据“固定顺序”工作表中列的顺序将“整理前”工作表恢复排序。

实现上述目的的代码如下：

Sub OrderRange()

Dim wksYesOrder AsWorksheet

Dim wksNoOrder AsWorksheet

Dim wksNew As Worksheet

Dim lngLastFixed As Long

Dim lngLastVariable As Long

Dim lngNewCol As Long

Dim i As Long

Dim SearchHeader, rng

'赋值工作表对象

Set wksYesOrder =Worksheets("固定顺序")

Set wksNoOrder =Worksheets("整理前")

Worksheets.Add Before:=wksNoOrder

ActiveSheet.Name = "整理后"

Set wksNew =Worksheets("整理后")

'获取数据区域所在的最后一列

lngLastFixed =wksYesOrder.Range("IV1").End(xlToLeft).Column

lngLastVariable =wksNoOrder.Range("IV1").End(xlToLeft).Column

'列计数变量

lngNewCol = 1

'遍历"固定顺序"工作表列标题

For i = 1 To lngLastFixed

SearchHeader =wksYesOrder.Cells(1, i)

'在"整理前"工作表中查找

With wksNoOrder

Set rng =.Range(.Cells(1, 1), .Cells(1, lngLastVariable)) _

.Find(SearchHeader, LookIn:=xlValues, LookAt:=xlWhole)

'如果找到则将该列复制到"整理后"工作表

If (Not rng Is Nothing) Then

.Cells(1,rng.Column).EntireColumn.Copy _

wksNew.Cells(1, lngNewCol)

lngNewCol =lngNewCol + 1

End If

End With

Next i

End Sub

上述代码的图片版如下：

运行代码后的结果如下图3所示：

图3