Sub BJ_Union删除大区_汇总款式销售信息并排序()
Application.DisplayAlerts = False
Dim St1 As Object, St2 As Object, Cel As Object, Rng As Object
Dim Row1 As Integer
'每次运行程序之前,删掉之前生成的排名表
For Each St1 In Sheets
If Right(St1.Name, 2) = "排名" Then '判断表名最后两个字符是否是"排名"
St1.Delete
End If
Next
'复制数据表,并命名
Sheets("案例数据").Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = "北京地区款式实销金额排名"
'获取行数
Set St2 = ActiveSheet
Row1 = St2.Range("A65536").End(xlUp).Row '排名表的行数
'删除其他大区
If St2.FilterMode = True Then St2.ShowAllData '取消筛选和隐藏
Set Rng = St2.Cells(St2.Cells.Rows.Count, "f") '初始时给rng增加一个没用的数据
For Each Cel In St2.Range("F2:F" & Row1)
If Left(Cel.Value, 3) <> "190" Then Set Rng = Union(Rng, Cel)
Next
Rng.EntireRow.Delete
'填充款号汇总公式
'St2.Range("l1").Value = "款号"
'St2.[M1].Value = "款式销量"
'St2.[N1].Value = "款式零售金额"
'St2.[O1].Value = "款式实销金额"
Row1 = St2.Range("A65536").End(xlUp).Row '排名表的行数
St2.Range("L1:O1").Value = Split("款号 款式销量 款式零售金额 款式实销金额", " ")
St2.Range("L2").Formula = "=LEFT(E2,LEN(E2)-5)"
St2.Range("M2").Formula = "=SUMIF($L:$L,$L2,H:H)"
'填充公式
'St2.Range("M2").AutoFill Destination:=St2.Range("M2:O2")
'St2.Range("L2:O2").AutoFill Destination:=St2.Range("L2:O" & Row1)
St2.Range("M2").Copy
St2.Range("N2:O2").PasteSpecial Paste:=xlPasteFormulas
St2.Range("L2:O2").Copy
St2.Range("L2:O" & Row1).PasteSpecial Paste:=xlPasteFormulas
'把公式选择性粘贴成数值
St2.Range("L:O").Copy
St2.Range("L:O").PasteSpecial Paste:=xlPasteValues
'删除款号重复项
St2.Range("A1:O324").RemoveDuplicates Columns:=Array(12), Header:=xlYes
'删除多余列
St2.Range("C:K").Delete
Row1 = St2.Range("A65536").End(xlUp).Row '排名表的行数
'按照款式实销金额进行排序
St2.Range("A1:F" & Row1).Sort Key1:=Range("F1"), Order1:=xlDescending, Header:=xlYes
Application.DisplayAlerts = True
End Sub