用Excel做数据分析：商品组合

这算数据分析？！

数据1：销售明细

销售明细

数据2：商品组合清单

商品组合清单

要求：在【销售明细表】中查询符合【商品组合清单】的销售单，即销售明细表中有一个（门店&流水号）中包含商品组合清单中任何一种组合的两种品种以上，则把这个门店的这个流水号的销售明细粘贴到组合销售明细表中！！！

思路：

• 1、先统计部门和流水号（分组）有多少个药品ID，然后去除重复。
• 2、对1中的数据进行计数，提取大于等于2的，即有2种组合的部门和流水号（分组）.
• 3、根据2中的部门和流水号链接明细数据。

SQL代码：

Sub cdsr()    Dim cnn As Object, rs As Object, i&, SQL$    Set cnn = CreateObject("ADODB.Connection")  cnn.Open "Provider = Microsoft.ace.Oledb.12.0;Extended Properties =Excel 12.0;Data Source =" & ThisWorkbook.FullName    SQL = "select distinct * from (select a.部门,a.流水号,a.药品ID from [销售明细$] a ,[商品组合清单$] b where a.药品ID=b.商品ID)"    SQL = "Select 部门,流水号 from (" & SQL & " ) group by 部门,流水号 having count(药品ID)>1"    SQL = "select t1.* from [销售明细$] t1,(" & SQL & ") t2 where t1.部门=t2.部门 and t1.流水号=t2.流水号"    Set rs = cnn.Execute(SQL)    Sheets("组合销售的明细").Range("a2:ac66666").ClearContents    Sheets("组合销售的明细").Range("a2").CopyFromRecordset rs    rs.Close    cnn.Close    Set rs = Nothing    Set cnn = NothingEnd Sub

VBA代码:

Sub cdsr1()    Dim arr(), brr(), i&, d As Object, d1 As Object    arr = Sheet1.[a1].CurrentRegion.Value    brr = Sheet3.[a1].CurrentRegion.Value    Set d = CreateObject("scripting.dictionary")    Set d1 = CreateObject("scripting.dictionary")    For i = 2 To UBound(arr)        d(arr(i, 2)) = arr(i, 1)    Next    For i = 2 To UBound(brr)        If d.exists(brr(i, 4)) Then            s = brr(i, 1) & brr(i, 3) & brr(i, 4)            ss = brr(i, 1) & brr(i, 3)            If Not d1.exists(s) Then                d1(s) = ""                d(ss) = d(ss) + 1            End If        End If    Next    For i = 2 To UBound(brr)        ss = brr(i, 1) & brr(i, 3)        If d(ss) > 1 Then            k = k + 1            For j = 1 To UBound(brr, 2)                brr(k, j) = brr(i, j)            Next        End If    Next    Sheet2.[a2:ab66666] = ""    Sheet2.[a2].Resize(k, UBound(brr, 2)) = brrEnd Sub

结果

结果

示例文件

链接: http://pan.baidu.com/s/1qXRae0O 密码: tv56