求助从A表提取有用项到B表，在B表内生成自动计算表和符合条件的清单

cp11888

1、试块制作登记（A）表 是从ERP管理软件导出来的
2、2018年7月（B）表 是手工添加的统计表
需要的作业内容：
1）将A表内容按月份从A表复制到B表（提取有用项），需要复制的内容：
  A、试块编号 B、强度等级（字母和数字分开）C、配合比编号
  D、成型日期 E、单位名称 F、工程名称 G、结构部位
2）“月统计表”需要自动生成如下内容：
  ①在新工作表生成周报表（7天）
     内容：C30～C60各强度等级7d、28d组数、达到设计值范围%
     7d低于达设计强度等级75%的组数
     28d低于达设计强度等级115%的组数
  ②在新工作表生成7d低于设计强度等级75%的明细报表
  ③在新工作表生成28d低于设计强度等级115%的明细报表

cp11888

7d低于75%的组数要，大于0%，低于75%组数，因为有空白项
28d低于115%的组数要，大于0%，低于115%组数，因为有空白项

q960126

1. Sub 提取()
   
2. Set b1 = Workbooks("试块制作登记（A）表.xls")
   
3. Set b2 = Workbooks("2018年7月（B）表.xlsx")
   
4. n = 4
   
5. For i = 1 To b1.Sheets(1).Range("c1").End(xlDown).Row
   
6. Set rg = b1.Sheets(1).Cells(i, "c")
   
7. If rg Like "*-08-*" Then //  08改成你要的月份
   
8. b2.Sheets(1).Cells(n, "e").Value = rg.Value
   
9. b2.Sheets(1).Cells(n, "a").Value = b1.Sheets(1).Cells(i, "a")
   
10. b2.Sheets(1).Cells(n, "d").Value = b1.Sheets(1).Cells(i, "b")
    
11. b2.Sheets(1).Cells(n, "b").Value = Left(b1.Sheets(1).Cells(i, "m"), 1)
    
12. b2.Sheets(1).Cells(n, "c").Value = Right(b1.Sheets(1).Cells(i, "m"), Len(b1.Sheets(1).Cells(i, "m")) - 1)
    
13. b2.Sheets(1).Cells(n, "t").Value = b1.Sheets(1).Cells(i, "x")
    
14. b2.Sheets(1).Cells(n, "u").Value = b1.Sheets(1).Cells(i, "y")
    
15. b2.Sheets(1).Cells(n, "v").Value = b1.Sheets(1).Cells(i, "z")
    
16. n = n + 1
    
17. End If
    
18. Next
    
19. End Sub
    

复制代码

俩个表都打开，这个只能帮你提取你要的东西

cp11888

代码放到B表里吗？

cp11888

q960126 发表于 2018-8-7 11:36
俩个表都打开，这个只能帮你提取你要的东西

在代码里增加一条龄期如何编码？

cp11888

q960126 发表于 2018-8-7 11:36
俩个表都打开，这个只能帮你提取你要的东西

Sub 提取()
Set b1 = Workbooks("试块制作登记（A）表.xls")
Set b2 = Workbooks("2018年8月（B）表.xlsx")
n = 4
For i = 1 To b1.Sheets(1).Range("c1").End(xlDown).Row
Set rg = b1.Sheets(1).Cells(i, "c")
If rg Like "*-08-*" Then '08改成你要的月份
b2.Sheets(1).Cells(n, "e").Value = rg.Value
b2.Sheets(1).Cells(n, "a").Value = b1.Sheets(1).Cells(i, "a")
b2.Sheets(1).Cells(n, "d").Value = b1.Sheets(1).Cells(i, "b")
b2.Sheets(1).Cells(n, "b").Value = Left(b1.Sheets(1).Cells(i, "m"), 1)
b2.Sheets(1).Cells(n, "c").Value = Right(b1.Sheets(1).Cells(i, "m"), Len(b1.Sheets(1).Cells(i, "m")) - 1)
b2.Sheets(1).Cells(n, "f").Value = b1.Sheets(1).Cells(i, "s")
b2.Sheets(1).Cells(n, "u").Value = b1.Sheets(1).Cells(i, "x")
b2.Sheets(1).Cells(n, "v").Value = b1.Sheets(1).Cells(i, "y")
b2.Sheets(1).Cells(n, "w").Value = b1.Sheets(1).Cells(i, "z")
n = n + 1
End If
Next
End Sub

q960126

依葫芦画瓢啊，你看我咋弄的就咋编啊

iwangyi

实现楼主的第一项作业要求功能
1. 选取月份。‘月份从B表中第（）月中直接填入需要月份
2.按楼主要求选择所需字段
3.将强度等级列分为数字及字母两列
代码如下

iwangyi

Sub ADO()
Set cn = CreateObject("ADODB.CONNECTION")
cn.Open "PROVIDER=MICROSOFT.JET.oledb.4.0;EXTENDED PROPERTIES=EXCEL 8.0;DATA SOURCE=" & ThisWorkbook.FullName
Sql = "SELECT 试件编号,MID(强度等级,1,1),MID(强度等级,2,LEN(强度等级)),配合比编号,成型日期,成型日期*0,成型日期*0,成型日期*0,成型日期*0,成型日期*0,成型日期*0,成型日期*0,成型日期*0,成型日期*0,成型日期*0,成型日期*0,成型日期*0,成型日期*0,成型日期*0,单位名称,工程名称,结构部位 from [试块制作登记（A）表$] where month(成型日期)=" & Cells(1, 13) & ""
Sheets("月统计").Range("A4").CopyFromRecordset cn.Execute(Sql)
End Sub

iwangyi

附件-------------