|
|
本帖最后由 szd1208 于 2018-5-6 18:00 编辑
Sub 排单()
Application.ScreenUpdating = False '关闭屏幕刷新
Sheets("排单").Activate
Sheets("排单").Cells.Clear '目的地工作表
Sheets("测试").Activate
Sheets("测试").Cells.Clear '中转工作表
Sheets("订单").Activate ' 原始工作表 不做改动 所以复制 Sheets("测试").
Range("C2:M5000").Select '中间有许多空行，下面写了 删除空行代码
Selection.Copy
Sheets("测试").Activate
Range("A2").Select
ActiveSheet.Paste
'粘贴到Sheets("测试").
Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
'Sheets("测试")删除空行代码
Range("A1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$G$44").AutoFilter Field:=1, Criteria1:="=*童装*", _
Operator:=xlAnd
'A列自定义筛选 包含“童装”
ActiveWorkbook.Worksheets("测试").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("测试").AutoFilter.Sort.SortFields.Add Key:=Range( _
"A1:A44"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("测试").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'A列 排序 降序
i = Sheets("测试").Range("a" & Cells.Rows.Count).End(3).Row
Range("a2:k" & i).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
'复制筛选 排序后的数据 结果
Sheets("排单").Activate
last = Sheets("排单").[A65536].End(xlUp).Row '取得行号
'开始增加新用户
Sheets("排单").Range("a" & last + 2).Select '订单号
ActiveSheet.Paste
'粘贴到Sheets("排单")A列
Sheets("测试").Select
Application.CutCopyMode = False
Selection.ClearContents
'回到 Sheets("测试") 清楚已经筛选的结果，进行下一个次的 自定义 筛选 排序
'下面3段代码基本上相同
ActiveSheet.Range("$A$1:$G$44").AutoFilter Field:=1, Criteria1:="=*套装*", _
Operator:=xlAnd
ActiveWorkbook.Worksheets("测试").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("测试").AutoFilter.Sort.SortFields.Add Key:=Range( _
"A1:A44"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("测试").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
i = Sheets("测试").Range("a" & Cells.Rows.Count).End(3).Row
Range("a2:k" & i).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("排单").Activate
last = Sheets("排单").[A65536].End(xlUp).Row '取得行号
'开始增加新用户
Sheets("排单").Range("a" & last + 2).Select '订单号
ActiveSheet.Paste
'
Sheets("测试").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveSheet.Range("$A$1:$G$44").AutoFilter Field:=1, Criteria1:="=*女装*", _
Operator:=xlAnd
ActiveWorkbook.Worksheets("测试").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("测试").AutoFilter.Sort.SortFields.Add Key:=Range( _
"A1:A44"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("测试").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
i = Sheets("测试").Range("a" & Cells.Rows.Count).End(3).Row
Range("a2:k" & i).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("排单").Activate
last = Sheets("排单").[A65536].End(xlUp).Row '取得行号
'开始增加新用户
Sheets("排单").Range("a" & last + 2).Select '订单号
ActiveSheet.Paste
'
Sheets("测试").Select
Application.CutCopyMode = False
Selection.ClearContents
ActiveSheet.Range("$A$1:$G$44").AutoFilter Field:=1, Criteria1:="=*训练服*", _
Operator:=xlAnd
ActiveWorkbook.Worksheets("测试").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("测试").AutoFilter.Sort.SortFields.Add Key:=Range( _
"A1:A44"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("测试").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
i = Sheets("测试").Range("a" & Cells.Rows.Count).End(3).Row
Range("a2:k" & i).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("排单").Activate
last = Sheets("排单").[A65536].End(xlUp).Row '取得行号
'开始增加新用户
Sheets("排单").Range("a" & last + 2).Select '订单号
ActiveSheet.Paste
Sheets("测试").Select
Application.CutCopyMode = False
Selection.ClearContents
'最后一段代码， 清楚所有上面已经筛选过的词，A列进行降序排序，剩余的数据全部复制到 Sheets("排单").A列，最下面，然后清空Sheets("测试")
ActiveSheet.Range("$A$1:$G$44").AutoFilter Field:=1
ActiveWorkbook.Worksheets("测试").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("测试").AutoFilter.Sort.SortFields.Add Key:=Range( _
"A1:A44"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("测试").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'
i = Sheets("测试").Range("a" & Cells.Rows.Count).End(3).Row
Range("a2:k" & i).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("排单").Activate
last = Sheets("排单").[A65536].End(xlUp).Row '取得行号
'开始增加新用户
Sheets("排单").Range("a" & last + 2).Select '订单号
ActiveSheet.Paste
Sheets("测试").Select
Application.CutCopyMode = False
Selection.ClearContents
Sheets("排单").Select
Range("G2").Select
Application.ScreenUpdating = True '打开屏幕刷新
End Sub
我录了个宏 ，大致改了下， 可以实现我的目的，
但是中间如果 原始数据中（”C2:M5000，后面也许更多M36000） ，如果没有筛选的“词“ ，目的地工作表会出现部分错误，
拜请老师帮助优化代码， 谢谢复制 工作表“订单”（”C2:M5000，后面也许更多 行）工作表“订单” 不做改动
在 工作表 “排单” 中， 按照，自定义筛选“童装”降序， “套装”降序， “女装” 降序，“训练服” 降序，几个关键词搜索后，剩余的排在下面。 老师可以 执行代码看下 效果
这个如果可以也帮写下， 可以和上面的代码合并，也可以单独， 如果不能做， 这个可以不做修改
在工作表（排单）我做了个按钮 是手工选择A 列中 几行完全相同数据，B列按照自定义 “XXS", "XS", "S", "M", "L", "XL", "XXL", "2XL", "3XL", "4XL", "5XL"”排序 ，
能不能 做到，一键点击按钮， 根据A列中 几行 完全相同数据，B列按照 自定义排序
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2018-5-6 02:12
发表于 2018-5-6 08:39
楼主