求助大神在多表数据中提取有用数据进行汇总分析

xt100

诉求：

1、数据表中的数据因是不同人员提供的，有些相同客户名称，写法不同，首先需要先将客户名称统一（客户名称对应在”客户对应“表中）。
2、在相同月份中有可能发生”销售明细“表中的客户有销售额，但在”运输明细“表中确没有体现这个客户，相反”运输明细“表中有，”销售明细“表中没有，也可能发生。所以需要在以月份为前提，先将这个客户名称先提取、汇在一起，然后去除重复值。
3、根据提取后的客户名称，来提取，月份、业务担当、销售数量、销售金额、运输费。最后用数据透视表作出以下图表。



不知道我表达清楚了没有，请老师们看看用什么方法能达成诉求，先行感谢啦

3190496160

Sub 分类汇总()
Application.ScreenUpdating = False
Dim ar As Variant, br As Variant, cr As Variant
Dim d As Object, dc As Object, dic As Object
Set d = CreateObject("scripting.dictionary")
Set dc = CreateObject("scripting.dictionary")
Set dic = CreateObject("scripting.dictionary")
Dim arr()
With Sheets("客户对应")
    r = .Cells(Rows.Count, 2).End(xlUp).Row
    If r < 2 Then MsgBox "客户对应表为空！": End
    ar = .Range("b1:d" & r)
End With
With Sheets("销售明细")
    rs = .Cells(Rows.Count, 2).End(xlUp).Row
    If rs < 2 Then MsgBox "销售明细为空！": End
    br = .Range("a1:g" & rs)
End With
With Sheets("运输明细")
    ws = .Cells(Rows.Count, 2).End(xlUp).Row
    If ws < 3 Then MsgBox "运输明细为空！": End
    cr = .Range("a2:h" & ws)
End With
For i = 2 To UBound(ar)
    If ar(i, 1) <> "" Then
        d(ar(i, 1)) = i
    End If
    If ar(i, 3) <> "" Then
        dc(ar(i, 3)) = i
    End If
Next i
ReDim arr(1 To UBound(br) + UBound(cr), 1 To 7)
For i = 2 To UBound(br)
    If br(i, 1) <> "" Then
        If IsDate(br(i, 1)) Then
            yf = Month(br(i, 1))
            zd = yf & "|" & br(i, 2)
            t = dic(zd)
            If t = "" Then
                k = k + 1
                dic(zd) = k
                t = k
                arr(k, 1) = yf & "月"
                arr(k, 2) = br(i, 2)
                xh = d(br(i, 2))
                If xh <> "" Then
                    arr(k, 3) = ar(xh, 2)
                    arr(k, 4) = ar(xh, 3)
                End If
            End If
            arr(t, 5) = arr(t, 5) + br(i, 5)
            arr(t, 6) = arr(t, 6) + br(i, 7)
        End If
    End If
Next i
For i = 2 To UBound(cr)
    If cr(i, 1) <> "" Then
        If IsDate(cr(i, 1)) Then
            yf = Month(cr(i, 1))
            h = dc(cr(i, 4))
            If h <> "" Then
                dw = ar(h, 1)
                zd = yf & "|" & dw
                t = dic(zd)
                If t = "" Then
                    k = k + 1
                    dic(zd) = k
                    t = k
                    arr(k, 1) = yf & "月"
                    arr(k, 2) = dw
                    arr(k, 3) = ar(h, 2)
                    arr(k, 4) = cr(i, 4)
                End If
                arr(t, 7) = arr(t, 7) + cr(i, 8)
            End If
        End If
    End If
Next i
With Sheets("数据汇总")
    .UsedRange.Offset(3) = Empty
    .[a4].Resize(k, UBound(arr, 2)) = arr
End With
Set d = Nothing
Set dc = Nothing
Set dic = Nothing
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

销售额与费用比.rar (45.63 KB, 下载次数: 8)

2024-5-10 10:51 上传

点击文件名下载附件

3190496160

第一行与模拟结果不完全相符，代码仅供参考，
实在不行，可以加v

xt100

3190496160 发表于 2024-5-10 10:52
第一行与模拟结果不完全相符，代码仅供参考，
实在不行，可以加v

好的谢谢，大神

pxy0409

VBA有点复杂了吧,数据查询更简单一些

xt100

pxy0409 发表于 2024-5-10 13:39
VBA有点复杂了吧,数据查询更简单一些

VBA太高大上了，由于本人太笨，研究半天还是不懂。谢谢老师提供的其它解决方案。

q1579398897

SQL方法：

1. SELECT 年份,月份,客户名称,业务担当,销售数量,销售金额,0 AS 运输费 FROM
   
2. (SELECT YEAR(CDATE(时间)) AS 年份,MONTH(CDATE(时间)) AS 月份,发货单位,SUM(数量（KG）) AS 销售数量,SUM(金额) AS 销售金额 FROM [销售明细$] GROUP BY YEAR(CDATE(时间)),MONTH(CDATE(时间)),发货单位) T1 LEFT JOIN [客户对应$] T2 ON T1.发货单位=T2.发货单位
   
3. UNION ALL
   
4. SELECT YEAR(CDATE(发货日期)) AS 年份,MONTH(CDATE(发货日期)) AS 月份,客户名称,业务担当, 0 AS 销售数量,0 AS 销售金额,SUM(运输费) AS 运输费 FROM [运输明细$] GROUP BY YEAR(CDATE(发货日期)),MONTH(CDATE(发货日期)),客户名称,业务担当

复制代码

xt100

q1579398897 发表于 2024-5-10 16:46
SQL方法：

谢谢老师，同一个问题竟然会有这多的方法。向您学习，非常感谢。