SQL高手？急！help sos

opiona

1.     Set SH1 = Sheets("Data")
   
2.     SH1.Range("A2:Z1048576").ClearContents
   
3.    
   
4.     Str_coon = "Provider=Microsoft.Ace.OLEDB.12.0;Data Source=" & ThisWorkbook.Path & "\测试.accdb;"
   
5.     Rem 季节    品牌    营销单号    系列名称    本厂款号    本厂颜色    下单日期    数量
   
6.    
   
7.     StrSQL = ""
   
8.     StrSQL = StrSQL & "SELECT [季节],[品牌],[营销单号],[系列名称]"
   
9.     StrSQL = StrSQL & ",'' AS [本厂款号],'' AS [本厂颜色]"
   
10.     StrSQL = StrSQL & ",[下单日期]"
    
11.     StrSQL = StrSQL & ",SUM([数量]) AS [数量]"
    
12.     StrSQL = StrSQL & " FROM ("
    
13.     Rem  防止出现：null
    
14.     StrSQL = StrSQL & "SELECT  IIF(ISNULL([季节])=TRUE,'',[季节]) AS [季节]"
    
15.     StrSQL = StrSQL & ",IIF(ISNULL([品牌])=TRUE,'',[品牌]) AS [品牌]"
    
16.     StrSQL = StrSQL & ",IIF(ISNULL([营销单号])=TRUE,'',[营销单号]) AS [营销单号]"
    
17.     StrSQL = StrSQL & ",IIF(ISNULL([系列名称])=TRUE,'',[系列名称]) AS [系列名称]"
    
18.    
    
19.     StrSQL = StrSQL & ",IIF(ISNULL([下单日期])=TRUE,'',[下单日期]) AS [下单日期]"
    
20.     StrSQL = StrSQL & ",IIF(ISNULL([数量])=TRUE,0,[数量]) AS [数量]"
    
21.     StrSQL = StrSQL & " FROM [营销订单]"
    
22.    
    
23.     StrSQL = StrSQL & ") GROUP BY [季节],[品牌],[营销单号],[系列名称],[下单日期]"
    
24.    
    
25.     SQLARR = GET_SQL_To_Arr(StrSQL, Str_coon, False)
    
26.    
    
27.     StrSQL = "SELECT DISTINCT [季节],[品牌],[营销单号],[系列名称],[本厂款号],[本厂颜色],[下单日期]"
    
28.     StrSQL = StrSQL & " FROM ("
    
29.     Rem  防止出现：null
    
30.     StrSQL = StrSQL & "SELECT  IIF(ISNULL([季节])=TRUE,'',[季节]) AS [季节]"
    
31.     StrSQL = StrSQL & ",IIF(ISNULL([品牌])=TRUE,'',[品牌]) AS [品牌]"
    
32.     StrSQL = StrSQL & ",IIF(ISNULL([营销单号])=TRUE,'',[营销单号]) AS [营销单号]"
    
33.     StrSQL = StrSQL & ",IIF(ISNULL([系列名称])=TRUE,'',[系列名称]) AS [系列名称]"
    
34.     StrSQL = StrSQL & ",IIF(ISNULL([本厂款号])=TRUE,'',[本厂款号]) AS [本厂款号]"
    
35.     StrSQL = StrSQL & ",IIF(ISNULL([本厂颜色])=TRUE,'',[本厂颜色]) AS [本厂颜色]"
    
36.     StrSQL = StrSQL & ",IIF(ISNULL([下单日期])=TRUE,'',[下单日期]) AS [下单日期]"
    
37.    
    
38.     StrSQL = StrSQL & " FROM [营销订单]"
    
39.     StrSQL = StrSQL & ")"
    
40.     ARX = GET_SQL_To_Arr(StrSQL, Str_coon, False)
    
41.    
    
42.     Dim STR款号, STR颜色 As String
    
43.     Dim BOOL As Boolean
    
44.     For X = 0 To UBound(SQLARR, 1)
    
45.         STR款号 = ","
    
46.         STR颜色 = ","
    
47.         BOOL = False
    
48.         For I = 0 To UBound(ARX, 1)
    
49.             If SQLARR(X, 0) = ARX(I, 0) And SQLARR(X, 1) = ARX(I, 1) And SQLARR(X, 2) = ARX(I, 2) And SQLARR(X, 3) = ARX(I, 3) And SQLARR(X, 6) = ARX(I, 6) Then
    
50.                 BOOL = True
    
51.                 If InStr(STR款号, "," & ARX(I, 4) & ",") = 0 Then '//  前后加上[,],防止包含关系
    
52.                     STR款号 = STR款号 & ARX(I, 4) & ","
    
53.                 End If
    
54.                 If InStr(STR颜色, "," & ARX(I, 5) & ",") = 0 Then '//  前后加上[,],防止包含关系
    
55.                     STR颜色 = STR颜色 & ARX(I, 5) & ","
    
56.                 End If
    
57.                
    
58.             End If
    
59.             BOOL = False
    
60.         Next
    
61.         If STR款号 <> "," Then
    
62.             STR款号 = VBA.Mid(STR款号, 2, Len(STR款号) - 2)
    
63.         End If
    
64.         If STR颜色 <> "," Then
    
65.             STR颜色 = VBA.Mid(STR颜色, 2, Len(STR颜色) - 2)
    
66.         End If
    
67.         SQLARR(X, 4) = STR款号
    
68.         SQLARR(X, 5) = STR颜色
    
69.     Next
    
70.     SH1.Range("A2").Resize(UBound(SQLARR, 1) + 1, UBound(SQLARR, 2) + 1) = SQLARR

复制代码

opiona

结果：

完整代码： 14885553.rar (50.36 KB, 下载次数: 13)

2018-5-19 15:22 上传

点击文件名下载附件

xiaoyu528

opiona 发表于 2018-5-19 15:22
结果：

完整代码：

对于您！不说了，感动！！！感恩！！！对不起，没别的词形容此时此刻的心情！感谢这个词不能完整的表达我此时的心情

xiaoyu528

宝贝万岁 发表于 2018-5-18 22:23
附件采用的是公共变量，类模块运行SQL，能将同类需求规范化。

步骤：调取数据到数组，转置数组，汇总 ...

非常好~~完美，顺便说说如何送花？

宝贝万岁

xiaoyu528 发表于 2018-5-19 22:15
非常好~~完美，顺便说说如何送花？

好用就行，要看原数据的话可以用我后面回复的帖子，一分二，原数据和汇总表都有，有变化的话代码也比较好改，这种代码的通用型比较高。花无所谓，能送就送，我也是偶尔上来学习的。