指定列有数值时跨表多列值相乘并按条件求和填入对应列

anline1739

fzxba 发表于 2022-12-13 11:21

谢谢你的代码，但我想要的sheet2里的明细不是固定的，而是由计算结果填入的。

fzxba

anline1739 发表于 2022-12-13 13:06
谢谢你的代码，但我想要的sheet2里的明细不是固定的，而是由计算结果填入的。

填入对应列  何为填入？我的理解就是据已知的填入，下面的参考

1. Sub test2() ' 事先要说明
   
2.   Dim Conn As Object, rs As Object
   
3.   Dim strConn As String, SQL As String, i As Integer
   
4.   
   
5.   Set Conn = CreateObject("ADODB.Connection")
   
6.   If Application.Version < 12 Then
   
7.     strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Excel 8.0;Data Source="
   
8.   Else
   
9.     strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source="
   
10.   End If
    
11.   Conn.Open strConn & ThisWorkbook.FullName
    
12.   
    
13.   SQL = "SELECT a.*,b.* FROM [sheet3$A1:F] a LEFT JOIN [sheet1$A1:D] b ON a.车间=b.所属车间 WHERE LEN(本次计划数量)"
    
14.   SQL = "SELECT 编码,图号,名称,'' AS 材料系列,'' AS 材料大类,'' AS 日期,'' AS 备注,SUM(数量*本次计划数量) AS 需求数量,'' AS 需求日期,'' AS 计划编号,'' AS 计划描述,'' AS 年度净需求量,SUM(数量*年度计划数量) AS 年度生产数量,'' AS 周度净需求量,SUM(数量*周度计划数量) AS 周度生产数量 FROM (" & SQL & ") GROUP BY 编码,图号,名称"
    
15.   Set rs = Conn.Execute(SQL)
    
16.    
    
17.   With Worksheets("sheet2").Range("A2")
    
18.     .CurrentRegion.ClearContents
    
19.     For i = 0 To rs.Fields.Count - 1
    
20.       .Offset(0, i) = rs.Fields(i).Name
    
21.     Next
    
22.     .Offset(1).CopyFromRecordset rs
    
23.   End With
    
24.   
    
25.   Set rs = Nothing
    
26.   Conn.Close
    
27.   Set Conn = Nothing
    
28.   Beep
    
29. End Sub

复制代码

anline1739

fzxba 发表于 2022-12-13 13:19
填入对应列  何为填入？我的理解就是据已知的填入，下面的参考

这个代码的结果是完全正确的，非常感谢！