按区间汇总金额

limonet

关键字：union all

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$, Arr As Variant, Rng$, i%, Rst As Object
    Rng = Worksheets("Sheet1").Range("F1").End(xlToRight).Address(0, 0)
    Set Cn = CreateObject("Adodb.Connection")
    Arr = Worksheets("Sheet1").Range(Worksheets("Sheet1").Cells(1, "F"), Rng)
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    For i = 1 To UBound(Arr, 2)
        StrSQL = StrSQL & " Union ALl Select 简码,商品名,类别,金额,备注,#" & Arr(1, i) & "# as 日期,cint([" & CLng(Arr(1, i)) & "]) as 数量 From [Sheet1$A:" & Left(Rng, Len(Rng) - 1) & "]"
        If i = 30 Or i = UBound(Arr, 2) Then
            Set Rst = Cn.Execute(Mid(StrSQL, 12))
            For j = 0 To Rst.Fields.Count - 1
                Cells(1, j + 1) = Rst.Fields(j).Name
            Next j
            Range("A" & Range("A" & Rows.Count).End(xlUp).Row + 1).CopyFromRecordset Rst
            StrSQL = ""
        End If
    Next i
End Sub

zllyyz

limonet 发表于 2024-3-1 20:54
关键字：union all

做了一半，剩下一半做完它 那就是最靓的仔

fzxba

   个人第888帖

zllyyz

fzxba 发表于 2024-3-2 10:37
个人第888帖

这SQL用的真六，那种方式的学习 练习能达到这程度呢

fzxba

zllyyz 发表于 2024-3-2 11:48
这SQL用的真六，那种方式的学习 练习能达到这程度呢

补：
最终调整_加上纯数组写法.zip (41.84 KB, 下载次数: 12)

2024-3-3 15:14 上传

点击文件名下载附件