VBA 采用SQL多条件求和代码修改

LWY003

各位导师，晚上好，求助一下，表格中的代码如何修改成图片中想要的结果？不胜感激！！！

WANT-T

        Sql = "select 日期,品名,类型,sum(IIF(类型='进货',金额,NULL)) as 进货,sum(IIF(类型='销售',金额,NULL)) AS 销售 from [明细$] group by 日期,品名,类型 order by 日期,品名 desc"

LWY003

WANT-T 发表于 2024-5-18 20:33
Sql = "select 日期,品名,类型,sum(IIF(类型='进货',金额,NULL)) as 进货,sum(IIF(类型='销售',金 ...

非常感谢导师的代码，解决了公式计算问题，非常值得肯定和支持，谢谢！！！

baofa2

1. Sql = "TRANSFORM SUM(金额) SELECT 日期,品名 FROM [明细$A2:F] GROUP BY 日期,品名 PIVOT 类型"

复制代码

Qs18

Sub 去重汇总()
    Dim Sql$, line&, i&
    Application.ScreenUpdating = False
     Set cnn = CreateObject("adodb.connection")
    Set rst = CreateObject("ADODB.RecordSet")
    With cnn
        .Open "Provider=Microsoft.Ace.oledb.12.0;extended properties='excel 12.0;HDR=yes';data source=" & ThisWorkbook.FullName
        Sql = "select 日期,品名,类型,sum(数量),sum(金额) from [明细$] group by 日期,品名,类型 order by 日期,品名,类型 desc"
       End With
       rst.Open Sql, cnn, 1, 3
For i = 1 To rst.RecordCount
     k = k + 1
    Sheet3.Cells(k + 4, 2).Value = rst.Fields(0)
    Sheet3.Cells(k + 4, 3).Value = rst.Fields(1)
    If rst.Fields(2) = "进货" Then
        Sheet3.Cells(k + 4, 4).Value = rst.Fields(4)
    Else
        Sheet3.Cells(k + 4, 5).Value = rst.Fields(4)
    End If
rst.MoveNext
Next i
arr = Array("日期", "品名", "进货", "销售")
Sheet3.Range("b5").Resize(1, 4) = arr
End Sub

LWY003

Qs18 发表于 2024-5-18 21:07
Sub 去重汇总()
    Dim Sql$, line&, i&
    Application.ScreenUpdating = False

感谢老师的回复与支持，代码相当完美，美中不足的地方就是当同一天同一品名销售与进货不在同一行，老师的代码分成两行来显示，希望相同的能在同一行显示就更完美了！

LWY003

baofa2 发表于 2024-5-18 20:51

感谢老师的代码，简洁明了，实在强大，美中不足的地方就是统计结果后，中间的地方变成多出为的空列了，附图片给老师看看

baofa2

LWY003 发表于 2024-5-18 21:43
感谢老师的代码，简洁明了，实在强大，美中不足的地方就是统计结果后，中间的地方变成多出为的空列了，附 ...

LWY003

baofa2 发表于 2024-5-18 21:49

牛牛牛牛，真的很牛

Qs18

Sub 去重汇总() '2024/05/19
     Dim Sql$, line&, i&
    Application.ScreenUpdating = False
     Set cnn = CreateObject("adodb.connection")
    Set rst = CreateObject("ADODB.RecordSet")
    With cnn
        .Open "Provider=Microsoft.Ace.oledb.12.0;extended properties='excel 12.0;HDR=yes';data source=" & ThisWorkbook.FullName
        Sql = "select 日期,品名,类型,sum(数量),sum(金额) from [明细$] group by 日期,品名,类型 order by 日期,品名,类型 desc"
       End With
      
       Sheet3.Range("a5:f10000").ClearContents
       arr = Array("日期", "品名", "进货", "销售")
       Sheet3.Range("b5").Resize(1, 4) = arr
       rst.Open Sql, cnn, 1, 3
Do While Not rst.EOF

If s <> rst.Fields(0) & rst.Fields(1) Then
    s = rst.Fields(0) & rst.Fields(1)
     k = Sheet3.Cells(Rows.Count, 2).End(xlUp).Row + 1
    Sheet3.Cells(k, 2).Value = rst.Fields(0)
    Sheet3.Cells(k, 3).Value = rst.Fields(1)
    If rst.Fields(2) = "进货" Then
        Sheet3.Cells(k, 4).Value = rst.Fields(4)
        Sheet3.Cells(k, 5).Value = 0
    ElseIf rst.Fields(2) = "销售" Then
        Sheet3.Cells(k, 5).Value = rst.Fields(4)
        Sheet3.Cells(k, 4).Value = 0
    End If
Else
m = Sheet3.Cells(Rows.Count, 2).End(xlUp).Row
    If rst.Fields(2) = "进货" Then
        Sheet3.Cells(m, 4).Value = rst.Fields(4)
    ElseIf rst.Fields(2) = "销售" Then
        Sheet3.Cells(m, 5).Value = rst.Fields(4)
    End If

End If
rst.MoveNext
Loop
Application.ScreenUpdating = True
MsgBox "处理完毕！"
End Sub