求大神帮忙，再线等

dsyxr903

为了提高工作效率，想做个更方便的出库单 ，请大神帮忙
能做到第一步就行，如果能做到第二步，就更厉害了

0星剑0

你来错版块了应该用VBA，我帮你做了一个

1. Sub 生成出库单()
   
2.     Dim arr, brr(), k, i, n
   
3.     Range("A2:H30000").ClearContents
   
4.     arr = Sheets("流水").[A1].CurrentRegion
   
5.     k = Application.CountIf(Sheets("流水").[K:K], [J1])
   
6.     If k = 0 Then Exit Sub
   
7.     ReDim brr(1 To k, 1 To 8)
   
8.     For i = 1 To UBound(arr)
   
9.         If arr(i, 11) = [J1] Then
   
10.             n = n + 1
    
11.             brr(n, 2) = arr(i, 3)
    
12.             brr(n, 3) = arr(i, 4)
    
13.             brr(n, 4) = arr(i, 5)
    
14.             brr(n, 5) = arr(i, 6)
    
15.             brr(n, 6) = arr(i, 7)
    
16.             brr(n, 7) = arr(i, 13)
    
17.             brr(n, 8) = arr(i, 12)
    
18.         End If
    
19.     Next
    
20.     [A2].Resize(UBound(brr), UBound(brr, 2)) = brr
    
21. End Sub
    

复制代码

第二个

1. Sub 排序合并()
   
2.     Dim r, i
   
3.     Application.DisplayAlerts = False
   
4.    
   
5.     Range("L2:S30000").UnMerge
   
6.     Range("L2:S30000").Clear
   
7.     r = Cells(Rows.Count, 2).End(3).Row
   
8.     Range("A2:H" & r).Copy [L2]
   
9.     Range("l2:S" & r).Sort [R2], 2, [M2], , 2
   
10.     For i = r To 2 Step -1
    
11.         If Cells(i, "M") = Cells(i, "M")(0, 1) Then
    
12.             Cells(i, "Q")(0, 1) = Cells(i, "Q")(0, 1) + Cells(i, "Q")
    
13.             Cells(i, "M")(0, 1).Resize(2, 1).Merge
    
14.             Cells(i, "L")(0, 1).Resize(2, 1).Merge
    
15.             Cells(i, "Q")(0, 1).Resize(2, 1).Merge
    
16.         End If
    
17.     Next
    
18.     Application.DisplayAlerts = True
    
19. End Sub
    

复制代码

dsyxr903

朱荣兴 发表于 2019-8-24 11:30
Sub chukudan() ''qq:705664849
With Sheets("出库单")
    .[a1].CurrentRegion.Offset(1) = Empty

谢谢大神，
排序合并单元格是不是做不了呢？

dsyxr903

0星剑0 发表于 2019-8-24 11:26
你来错版块了应该用VBA，我帮你做了一个

第二个

太棒了，要的就是这个效果，谢谢

dsyxr903

0星剑0 发表于 2019-8-24 11:26
你来错版块了应该用VBA，我帮你做了一个

第二个

您好，能不能帮我在原文件上做一个发货单？我的QQ350351319