Sub 滞销商品筛选()
'获取用户输入
Dim choice As Integer
On Error GoTo esc
choice = InputBox("请输入需要清理的月份")
'新建一个工作表作为临时处理区域
Dim temp As Worksheet
Set temp = Worksheets.Add(after:=Worksheets(Worksheets.Count))
'拷贝原有区域
Worksheets(choice).Activate
Dim rownum As Integer
rownum = ActiveSheet.Range("A3").CurrentRegion.Rows.Count
ActiveSheet.Range(Cells(3, 1), Cells(rownum, 6)).Copy
'粘贴到临时工作表
temp.Activate
ActiveSheet.Paste
'按照名称排序
temp.Range(Cells(1, 1), Cells(rownum - 2, 6)).sort Key1:=Range("A1")
'查找应该下架的货品名称
Dim goodname(100) As String
Dim index As Integer
index = 1
For i = 2 To rownum - 2
If (Cells(i, 1) = Cells(i - 1, 1)) And _
(Cells(i, 5) - Cells(i - 1, 5) > 20) And _
(Cells(i, 1) <> goodname(index - 1)) Then
goodname(index) = Cells(i, 1)
index = index + 1
End If
Next i
'将货品名称拼接为列表
Dim result As String
For i = 1 To index - 1
result = result & goodname(i) & Chr(10)
Next i
'显示结果
MsgBox choice & "月份20天内没有售出的货品清单如下:" & Chr(10) & result
'删除临时工作表
Application.DisplayAlerts = False
temp.Delete
'将原表中的对应记录标示出来
Worksheets(choice).Activate
For i = 3 To rownum - 2
For j = 1 To index - 1
If Cells(i, 1) = goodname(j) Then
Cells(i, 7).value = "滞销"
Cells(i, 7).Font.ColorIndex = 3
End If
Next j
Next i
esc: Exit Sub
End Sub