用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 = Nothing
End 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)) = brr
End Sub

结果

结果

---

示例文件

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