vba筛选排序

Option Explicit

Sub 天地齐寿日月同庚()

Dim i%, b As Workbook, fname$, j2%, j3%, j4%, j5%, k%
fname = "天地齐寿,日月同庚.xls"
Set b = Workbooks.Open("C:\Users\admin\Desktop\" & fname)
fname = "天地齐寿"
b.SaveAs Filename:="C:\Users\admin\Desktop\" & fname, FileFormat:=xlWorkbookNormal
Set b = Workbooks.Open("C:\Users\admin\Desktop\" & fname & ".xls")
'先对第5列进行降序排序
'定义一个range().sort,然后定义Key1,order1
'range()定义整个数据范围,Key1用于定义哪一列,order1定义升序Ascend或者降序Descend
Worksheets(1).Range("A:E").Sort _
Key1:=Worksheets(1).Cells(1, 5), order1:=xlDescending

'添加4张子表,并把C列剪切到B列前面
Worksheets.Add after:=Worksheets(1), count:=4
Worksheets(2).Name = "100~199"
Worksheets(3).Name = "200~299"
Worksheets(4).Name = "300~399"
Worksheets(5).Name = "400以上"
Worksheets(1).Columns("C:C").Cut
Worksheets(1).Columns("B:B").Insert Shift:=xlToRight

i = 2
j2 = 2: j3 = 2: j4 = 2: j5 = 2
'判断取值范围并把数据复制到其他相对应的子表
Do While Worksheets(1).Cells(i, 5) <> ""
    If Worksheets(1).Cells(i, 5) >= 100 And Worksheets(1).Cells(i, 5) <= 199 Then
        Worksheets(2).Cells(j2, 1) = Worksheets(1).Cells(i, 1)
        Worksheets(2).Cells(j2, 2) = Worksheets(1).Cells(i, 2)
j2 = j2 + 1
    ElseIf Worksheets(1).Cells(i, 5) >= 200 And Worksheets(1).Cells(i, 5) <= 299 Then
        Worksheets(3).Cells(j3, 1) = Worksheets(1).Cells(i, 1)
        Worksheets(3).Cells(j3, 2) = Worksheets(1).Cells(i, 2)
j3 = j3 + 1
    ElseIf Worksheets(1).Cells(i, 5) >= 300 And Worksheets(1).Cells(i, 5) <= 399 Then
        Worksheets(4).Cells(j4, 1) = Worksheets(1).Cells(i, 1)
        Worksheets(4).Cells(j4, 2) = Worksheets(1).Cells(i, 2)
j4 = j4 + 1
    ElseIf Worksheets(1).Cells(i, 5) >= 400 Then
        Worksheets(5).Cells(j5, 1) = Worksheets(1).Cells(i, 1)
        Worksheets(5).Cells(j5, 2) = Worksheets(1).Cells(i, 2)
j5 = j5 + 1
    End If
    i = i + 1
Loop


b.Close

End Sub



posted @ 2021-12-08 10:32  orientObject  阅读(680)  评论(0)    收藏  举报