自动分解，求助

kanonxu

sheet1里的表格，按数量分拆成一行一件。求大神帮忙弄一下。



↑sheet1


↑ sheet2

shiruiqiang

shiruiqiang

Sub test()
Dim arr, brr(1 To 1000, 1 To 6)
arr = Sheets(1).[a1].CurrentRegion
For x = 2 To UBound(arr)
For i = 1 To arr(x, 6)
    n = n + 1
    For y = 1 To 5
    brr(n, y) = arr(x, y)
    Next
    brr(n, 6) = 1
Next
Next

Sheets(2).[a2].Resize(n, 6) = brr
End Sub

ykcbf1100

行列转置问题

剑指E

一剑惊心

用PQ大法也很快的

bqwd36

学习一下字典多条件去重求和

1. Sub 求和()
   
2. Dim wb As Workbook, i%, arr
   
3. Set wb = ThisWorkbook
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. arr = wb.Sheets(2).[a1].CurrentRegion
   
6. For i = 2 To UBound(arr)
   
7.     ss = arr(i, 1) & "|" & arr(i, 2) & "|" & arr(i, 3) & "|" & arr(i, 4) & "|" & arr(i, 5)
   
8.     d(ss) = d(ss) + arr(i, 6)
   
9. Next
   
10. c = UBound(arr, 2): i = 2
    
11. With wb.Sheets(1)
    
12. For Each Key In d.Keys
    
13.     .Cells(i, 1).Resize(1, c - 1) = Split(Key, "|")
    
14.     i = i + 1
    
15. Next
    
16. .Cells(2, c).Resize(d.Count, 1) = Application.Transpose(d.items)
    
17. End With
    
18. End Sub

复制代码