根据出入库汇总表制作出入库单

Wanvtime · 发表于 2024-12-18 11:15

能请老师帮忙再修改一下代码吗？我对VB只能说是半杯水的水平，哈哈。勉强能看懂一些简单的代码而已

3190496160 · 发表于 2024-12-19 08:34

Sub 生成出库单()
Application.ScreenUpdating = False
Dim ar As Variant
Dim i As Long, r As Long, rs As Long
Dim br()
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("材料出入库汇总表")
r = .Cells(Rows.Count, 1).End(xlUp).Row
If r < 6 Then MsgBox "材料出入库汇总表工作表为空！": End
ar = .Range("a5:p" & r)
End With
For i = 2 To UBound(ar)
If ar(i, 14) <> "" And ar(i, 15) <> "" Then
      zd = ar(i, 14) & "|" & ar(i, 15)
      If Not d.exists(zd) Then Set d(zd) = CreateObject("scripting.dictionary")
      d(zd)(i) = ""
End If
Next i
Set sh = Sheets("模板")
With Sheets("出入库单")
.UsedRange.Clear
.Rows("1:10000").RowHeight = 13.5
rs = 1
For Each k In d.keys
      n = 0: hj = 0
      ReDim br(1 To d(k).Count, 1 To 8)
      For Each kk In d(k).keys
         n = n + 1
         br(n, 1) = n
         For j = 2 To 4
            br(n, j) = ar(kk, j)
         Next j
         br(n, 5) = ar(kk, 10)
         br(n, 6) = ar(kk, 5)
         br(n, 7) = ar(kk, 11)
         br(n, 8) = ar(kk, 14)
         rq = ar(kk, 15)
         'hj = hj + ar(kk, 11)
      Next kk
      For i = 1 To n Step 10
         w = 0: a = a + 1
         ReDim cr(1 To n, 1 To 8)
         For s = i To i + 9
            If s <= n Then
                  w = w + 1
                  For j = 1 To 8
                     cr(w, j) = br(s, j)
                  Next j
            End If
         Next s
         sh.Rows("1:16").Copy .Cells(rs, 1)
         .Cells(rs + 2, 4) = rq
         .Cells(rs + 4, 1).Resize(w, UBound(cr, 2)) = cr
         .Cells(rs + 4, 1).Resize(w, UBound(cr, 2)).Borders.LineStyle = 1
         .Cells(rs + 2, 8) = "NO." & Format(a, "0000")
         rs = rs + 18
      Next i
Next k
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160 · 发表于 2024-12-19 08:35

出入库单.rar (53.13 KB, 下载次数: 3)

Wanvtime · 发表于 2024-12-19 10:33

3190496160 发表于 2024-12-19 08:34
Sub 生成出库单()
Application.ScreenUpdating = False
Dim ar As Variant

非常感谢老师的帮助！！

3190496160 · 发表于 2024-12-19 10:36

Wanvtime 发表于 2024-12-19 10:33
非常感谢老师的帮助！！

有用至少送朵小花呀

Wanvtime · 发表于 2024-12-20 11:57

3190496160 发表于 2024-12-19 10:36
有用至少送朵小花呀

应该的不过没送过咋送鲜花的啊？

		自动登录	找回密码
密码			免费注册

[求助] 根据出入库汇总表制作出入库单

评分