vba 处理excel 排序

Sub opgo()



'-------------- 指定列配置定区域---------------------
Dim xiaoshouelie, maolielie, maolilvlie, xiaoshouebiaoshi, maoliebiaoshi, maolilvbiaoshi, paixuquyu
paixuquyu_begin = "A" '参与排序最小列
paixuquyu_end = "G" '参与排启最大列

xiaoshouelie = "B" '销售额列
maolielie = "C" '毛利额列
maolilvlie = "D" '毛利率列

xiaoshouebiaoshi = "E" '销售额标识
maoliebiaoshi = "F" '毛利额标识 "
maolilvbiaoshi = "G" ' 毛利率标识
huizongbiaoshi = "H" '汇总标识
'--------------- 初始信息获取-------------------------
'maxrow = Cells(Rows.Count, s).End(xlUp).Row
'maxrow = Cells(Rows.Count, "a").End(xlUp).Row
'Range(s & "2:" & s & i).ClearContents



Set sht = ActiveWorkbook.Sheets("sheet1")
sht.Activate
maxrow = sht.UsedRange.Rows.Count    '获取当前表最大行数

Range(xiaoshouebiaoshi & "2:" & xiaoshouebiaoshi & maxrow).ClearContents
Range(maoliebiaoshi & "2:" & maoliebiaoshi & maxrow).ClearContents
Range(maolilvbiaoshi & "2:" & maolilvbiaoshi & maxrow).ClearContents
Range(huizongbiaoshi & "2:" & huizongbiaoshi & maxrow).ClearContents

'激活当前工作表，Sort只能排序当前工作表
'--------------- 删除无效行------------------------------------------------------------------------------------------------------------
For i = 2 To maxrow '删除销售额为0或者为空的行
Dim xiaoshoue
xiaoshoue = Range(xiaoshouelie & i).Value
If (xiaoshoue = 0 Or xiaoshoue = "") Then
    MsgBox "删除行：" & i
    Rows(i).Delete
End If
Next
maxrow = sht.UsedRange.Rows.Count    '删除后重新获取当前表最大行数
'-------------- 按销售额排序------------------------------------------------------------ ----------- ---------------------
'sht.Range("A2:m" & maxRow).Sort key1:=sht.Range("B2"), order1:=xlDescending, Header:=xlNo
quyu = paixuquyu_begin & "2:" & paixuquyu_end & maxrow
Key = xiaoshouelie & "2"
sht.Range(quyu).Sort key1:=sht.Range(Key), order1:=xlDescending, Header:=xlNo
'sht.Range(quyu).Sort keyl:=sht.Range(Key), order1:=xlDescending, Header:=xlNo
Dim zongxiaoshoujine
zongxiaoshoujine = Application.WorksheetFunction.Sum(Columns(get_number(xiaoshouelie))) '获取所有销售金额
'Range("jl") = zongxi aoshouj ine J Application. Sum(Columns(1)) J zongxiaoshoujine
For i = 2 To maxrow
Dim zhanbi, zhanbileiji '占比占比累计
zhanbi = Range(xiaoshouelie & i).Value / zongxiaoshoujine
If i = 2 Then
zhanbileiji = zhanbi
Else
zhanbileiji = zhanbileiji + zhanbi
End If
'Range("k" & i) = zhanbi 'Range。］." & i) = zhanbileiji
If (zhanbileiji < 0.7999) Then
Range(xiaoshouebiaoshi & i) = "A"
ElseIf (zhanbileiji < 0.9499) Then
Range(xiaoshouebiaoshi & i) = "B"
Else
Range(xiaoshouebiaoshi & i) = "C"
End If
Next
 

'----------------- 按毛利额排序-----------------------------------------------------------------------------------------------------------
quyu = paixuquyu_begin & "2:" & paixuquyu_end & maxrow
Key = maolielie & "2"
sht.Range(quyu).Sort key1:=sht.Range(Key), order1:=xlDescending, Header:=xlNo

'sht.Range(paixuquyu_begin & "2:" & paixuquyu_end & maxRow).Sort keyl:=sht.Range(maolielie & "2"), order1:=xlDescending, Header:=xlNo
Dim zongmaolijine
zongmaolijine = Application.WorksheetFunction.Sum(Columns(get_number(maolielie)))     '获取所有毛利额累加
For i = 2 To maxrow
Dim zhanbi2, zhanbileiji2 '占比占比累计
zhanbi2 = Range(maolielie & i).Value / zongmaolijine
If i = 2 Then
zhanbileiji2 = zhanbi2
Else
zhanbileiji2 = zhanbileiji2 + zhanbi2
End If
'Range("k" & i) = zhanbi2 ' Range("1" & i) = zhanbileiji2
If (zhanbileiji2 < 0.7999) Then
Range(maoliebiaoshi & i) = "A"
ElseIf (zhanbileiji2 < 0.9499) Then
Range(maoliebiaoshi & i) = "B"
Else
Range(maoliebiaoshi & i) = "C"
End If
Next

'__ --------------------处理毛利率-----------------------------------------------------------------------------------------------------
For i = 2 To maxrow
Dim maolilv
maolilv = Range(maolilvlie & i).Value
If (maolilv > 0.5) Then
Range(maolilvbiaoshi & i) = "A"
Else
Range(maolilvbiaoshi & i) = ""
End If
Range(huizongbiaoshi & i) = Range(xiaoshouebiaoshi & i).Value & Range(maoliebiaoshi & i).Value & Range(maolilvbiaoshi & i).Value   '合并汇总
Next
MsgBox "分析结束!"
ActiveWorkbook.Save
End Sub
Function get_number(letter) '根据列字母得到第几列
Dim letterl
letterl = Asc(UCase(letter))
get_number = (letterl - 64)
End Function