求助：多行相同名称转列，并汇总。

雾中大少

求助：用VBA实现，  多行相同名称转列，并汇总。如图

雾中大少

继续求助

zpy2

create table 工单号合并明细表2 as   select fillna(工单号) 工单号,fillna_2(总毛重) 总毛重,配件名称,重量 from 工单号合并明细表


select 工单号,总毛重,group_concat(配件名称||':'||配件重量,'</td><td>') 配件明细 from (select 工单号,总毛重,配件名称,sum(重量) 配件重量 from 工单号合并明细表2 group by 工单号,配件名称) group by 工单号

魂断蓝桥

Sub a()
    Dim arr, i, d, k, t, r As Range, j
    Set d = CreateObject("Scripting.Dictionary")
    arr = [a1].CurrentRegion
    Set r = [a1].CurrentRegion
    [F2:Z9999] = ""
    For i = 2 To UBound(arr)
        t = 6
        For j = i To Cells(i, 1).MergeArea.Count + i - 1
            d(arr(j, 4)) = d(arr(j, 4)) + arr(j, 5)
        Next
        For Each k In d.KEYS
            Cells(i, t) = k & ":" & Format(d(k), "0.00")
            t = t + 1
        Next
        d.RemoveAll
        i = i + Cells(i, 1).MergeArea.Count - 1
    Next
    Set d = Nothing
End Sub

魂断蓝桥

代码审核中

[attachimg]2534351[/attachimg

一把小刀闯天下

'假设D列分段有序，，，

Option Explicit

Sub test()
  Dim arr, i, j, p, n, max, sum
  arr = [a1].CurrentRegion.Offset(1).Resize(, 5).Value
  ReDim brr(1 To UBound(arr, 1) - 1, 1 To 50) As String
  For i = 1 To UBound(arr, 1) - 1
    sum = sum + arr(i, 5)
    If arr(i, 4) <> arr(i + 1, 4) Or i = UBound(arr, 1) - 1 Or Len(arr(i + 1, 2)) > 0 Then
      n = n + 1
      brr(p + 1, n) = arr(i, 4) & ":" & sum: sum = 0
      If Len(arr(i + 1, 2)) Then
        If max < n Then max = n
        n = 0: p = i
      End If
    End If
  Next
  [f2].Resize(UBound(brr, 1), max) = brr
End Sub

笨鸟飞不高

Sub AwTest()
    Dim i%, x%, r%, y%, c%, s, n%, kStr$, arr, d As Object
    Set d = CreateObject("Scripting.Dictionary")
    arr = Range("A1:E" & Cells(Rows.Count, 5).End(3).Row)
    ReDim brr(1 To UBound(arr), 1 To UBound(arr))
    r = 1
    brr(r, 1) = "序号": brr(r, 2) = "工单号": brr(r, 3) = "总毛重"
    For i = 2 To UBound(arr)
        If Len(arr(i, 2)) Then kStr = arr(i, 2)
        x = d(kStr)
        If x = 0 Then r = r + 1: d(kStr) = r: brr(r, 1) = arr(i, 1): _
                brr(r, 2) = arr(i, 2): brr(r, 3) = arr(i, 3): x = r: c = 3
        y = d(kStr & "|" & arr(i, 4))
        If y = 0 Then c = c + 1: d(kStr & "|" & arr(i, 4)) = c: y = c: s = 0
        s = s + arr(i, 5): brr(x, y) = arr(i, 4) & ":" & s
        n = Application.Max(n, c)
    Next
    [f:z].Clear
    [g1].Resize(r, n) = brr
End Sub

笨鸟飞不高

多行相同名称转列，并汇总.zip (17.19 KB, 下载次数: 14)

2020-8-11 12:21 上传

点击文件名下载附件

笨鸟飞不高

一把小刀闯天下 发表于 2020-8-11 12:11
'假设D列分段有序，，，

Option Explicit

感谢小刀老师的鼓励！！！

雾中大少

一把小刀闯天下 发表于 2020-8-11 12:11
'假设D列分段有序，，，

Option Explicit

感谢一刀老师