Sub POP利润核算()
Dim r_range As Long, c_range As Long
Worksheets("快递费-VBA程序").Activate
Worksheets("快递费-VBA程序").Range("a1:az100000").Select
Selection.ClearContents '仅清除内容,相当于按下键盘delect键,防止其他联动公式受到伤害
'获取所有行数和列数
r_range = Worksheets("POP订单明细").UsedRange.Rows.Count
c_range = Worksheets("POP订单明细").UsedRange.Columns.Count
Debug.Print (Cells(r_range, c_range).Address)
'复制粘贴内容
Worksheets("POP订单明细").Range("a1:" & Cells(r_range, c_range).Address).Copy Worksheets("快递费-VBA程序").Range("a1:" & Cells(r_range, c_range).Address)
Worksheets("快递费-VBA程序").Range("a1:a1").Select
Application.CutCopyMode = False '取消复制状态,显示状态等同于取消剪贴板内容
Selection.AutoFilter '添加筛选
'筛选所有有删除 或者 锁定 的内容 注意下面的xlOr 如果是并且,需要改为xlAnd
ActiveSheet.Range("a1:" & Cells(r_range, c_range).Address).AutoFilter Field:=12, Criteria1:= _
"=*删除*", Operator:=xlOr, Criteria2:="=*锁定*"
Debug.Print (r_range)
'对筛选的内容进行操作
With Range("2:" & r_range)
.SpecialCells(xlCellTypeVisible).Delete '删除已筛选的结果,不删除隐藏项
'.EntireRow.Hidden = False '将隐藏项取消隐藏,但是筛选标签并不会消失,后改为取消筛选状态
End With
ActiveSheet.AutoFilterMode = False '取消筛选状态
Columns("b:b").Select
'向右选中所有列,并仅清除内容,相当于按下键盘delect键,防止其他联动公式受到伤害
Range(Selection, Selection.End(xlToRight)).Select
Selection.ClearContents
'删除重复项
Columns("A:A").Select
ActiveSheet.Range("a1:" & Cells(r_range, c_range).Address).RemoveDuplicates Columns:=1, Header:=xlYes
'输入公式
Range("b1").Select
ActiveCell.FormulaR1C1 = "=counta(C[-1])-1"
Range("c1").Select
ActiveCell.FormulaR1C1 = "=RC[-1]*4"
End Sub