大家都在搜
关注稻壳领福利
客户订单明细表
销售订单表
订单汇总明细表
销售明细表
酒店民宿青旅订单登记表
销售订单明细表-订单查询
车储收款明细
销售明细登记表
已处理订单明细表
订单统计表（自动计算）
销售订单明细表模板
设计作品50 独家高品质原创文档
举报
销售员销售统计表-自动统计
出口订单EXW出厂价利润核算一览
售楼部对账明细表
售楼部对账明细表售房对账明细表
借款明细表
房地产销售签约明细台帐
顾客消费表（美容美发）
项目明细表
我的
福利
反馈
微信咨询在线客服
客服
回到顶部
![根据原订单明细生成新的订单明细-表格模板接单日期客户名称型号数量订单号客户要求交货日期出货地址实际出货日期43787.0功能：根据K1的日期，从表2中筛选该实际出货日期的明细,2019/9/25塑壳SK-1265-2339.02019/11/10扬州表1：新订单明细表注：宏安全性设为“低”！,2019/9/25塑管SG-5554-1289.02019/11/10宿迁表2：原订单明细表,XXX-003塑棒SB-6967-3334.0泗洪1)需要从表2中提出哪一天交货，就写哪,塑管SG-5554-1262.0宿迁一天的日期；,塑壳SK-1495-22373.0南京2)按下“筛选该日期交货的明细”，会,将表2中实际出货日期是11/15的明细,全部筛选到表1这份表里；,3）按下“一键生成新表在桌面”按钮，会将,表1另存一份没有这两个按钮及VBA代码的新,表，新表名称是K1单元格内容，即“11月15日”,原理：用VBA单条件提取多项数据,第一部分代码：将表2中实际出货日期与表1中K1单元格的日期一致的明细,全部筛选到表1；,Sub test(), Application.ScreenUpdating = False屏幕刷屏关闭, Dim lastrow, lastrow2 As Integer将lastrow,lastrow定义为整型, Dim arr定义arr，默认为Variant类型, Dim brr定义brr，默认为Variant类型, Dim i, j, k As Integer, Dim mypath As String, Dim sht As Worksheet, Set sht1 = Worksheets(1)将当前工作簿里的第一个工作簿设为sht1, Set sht2 = Worksheets(2)将当前工作簿里的第二个工作簿设为sht2, With sht2, lastrow2 = .[a65536].End(xlUp).Row将表2最后一个非空单元格行号赋给lastrow2, arr = .Range("A3:P" & lastrow2)将表2中A3到P lastrow2的单元格全部赋给arr数组, End With, j = 0, ReDim brr(1 To 100, 1 To 9) As String将brr重新定义为100行，9列的动态二维数组，数据类型定义为字符类型, For i = 1 To UBound(arr)将i=1开始做循环到arr数组的上界, If arr(i, 12) = sht1.Range("K1").Value Then如果表2中的第i行，12列单元格中的日期与表1中K1单元格日期一致，则执行以下语句, j = j + 1j=1, brr(j, 1) = arr(i, 1)将表2的这符合的第i行1列单元格赋值给数组brr（1,1）, brr(j, 2) = arr(i, 2)将表2的这符合的第i行1列单元格赋值给数组brr（1,2）, brr(j, 3) = arr(i, 3)以下同理可得, brr(j, 4) = arr(i, 4), brr(j, 5) = arr(i, 5), brr(j, 6) = arr(i, 8), brr(j, 7) = arr(i, 9), brr(j, 8) = arr(i, 11), brr(j, 9) = arr(i, 12), Else: End If如果表2中的第i行，12列单元格中的日期与表1中K1单元格日期不一致,则继续For, Next, sht1.Range("A3:I65536").Clear清除A3：I3向下的单元格 , If brr(1, 1) <> "" Then判断brr(1,1)如果不为空则将brr数组的值贴到表1，A2单元格开始的表里, sht1.[A2].Resize(j, 9) = brr, Else, Worksheets(1).Range("A2:I2") = ""如果表1中K1的值是2019/11/12，表2没有对应的明细，brr(1,1)为空，则终止IF语句, End If, sht1.[E2] = Format(Range("E2"), "0"), lastrow1 = sht1.[a65536].End(xlUp).Row将表1最后一个非空单元格行号赋给lastrow1, For k = 2 To lastrow1, sht1.Cells(k, 5) = Format(Cells(k, 5), "0")将表1中第5列的数据强制显示为数值0的格式, Next, Application.Worksheets(1).Cells(2, "A").Resize(1, 9).Copy复制A2到I2的单元格, Worksheets(1).Range("A2:I" & lastrow1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone选择A2:I lastrow1的单元格，进行格式刷功能, Application.CutCopyMode = False清空剪贴板, Application.ScreenUpdating = True屏幕刷屏开启,End Sub,第二部分代码：将表1另存一份没有这两个按钮及VBA代码的新表，新表名,称是K1单元格内容，即“11月15日”；,Sub daochu(), Application.ScreenUpdating = False, Dim sh As Worksheet, path$, Dim t As String, path = "D:\Users\YZ316\Desktop\", hh = Worksheets(1).[a65536].End(xlUp).Row, arr = Range("A1:I" & hh), t = Format(Range("K1").Value, "mるdら"), Workbooks.Add, ActiveWorkbook.SaveAs Filename:=path & t & ".xls", Worksheets(1).Range("a1").Resize(UBound(arr), 9) = arr, Worksheets(1).Range("A1:I" & UBound(arr)).Borders.LineStyle = 1, Worksheets(1).Range("A1:I" & UBound(arr)).EntireColumn.AutoFit, ActiveWorkbook.Close True, Application.ScreenUpdating = True,End Sub,,9月份营业额明细,接单日期客户名称型号数量单价金额订单号客户要求交货日期工厂确认交货日期出货地址实际出货日期,XXX-001SG-5094-1266.059.03894.0深圳,SB-6987-3336.0195.07020.0广东43783.0,SB-6587-3332.0114.03648.0上海,57.08037.0南京,SK-1265-2339.040.01560.0扬州,25.03275.0泗洪,SB-6667-3338.014.0532.0徐州,SG-5554-1289.043.03827.0宿迁,83.026.02158.0美国,SB-76987-3313.058.0754.0日本,34.04454.0泗洪,XXX-004SB-6667-3377.014.01078.0徐州,SG-5554-1262.043.02666.0宿迁,18.02538.0深圳,SK-1265-237.040.0280.0广东,XXX-00449.06419.0上海,73.010293.0南京](http://personal.wpscdn.cn/app/new-www-docer-com/img/loading-img-42.ffcbba5.gif)