|
|
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
Sub 分表()
Application.ScreenUpdating = False
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("日报")
r = .Cells(Rows.Count, 2).End(xlUp).Row
If r < 3 Then MsgBox "日报表为空！": End
ar = .Range("a2:n" & r)
End With
For Each sh In Sheets
d(sh.Name) = ""
Next sh
Dim br()
For j = 12 To 14
n = 0
ReDim br(1 To UBound(ar), 1 To 6)
For i = 2 To UBound(ar)
If Trim(ar(i, j)) <> Empty Then
n = n + 1
br(n, 1) = ar(i, 3)
br(n, 2) = ar(i, 4)
br(n, 3) = ar(i, 6)
br(n, 4) = ar(1, j)
br(n, 5) = ar(i, j)
br(n, 6) = ar(i, 2)
End If
Next i
mc = ar(1, j) & "存仓入库"
If n > 0 Then
If d.exists(mc) Then
With Sheets(mc)
.UsedRange.Offset(1).Borders.LineStyle = 0
.UsedRange.Offset(1) = Empty
.[a2].Resize(n, UBound(br, 2)) = br
.[a2].Resize(n, UBound(br, 2)).Borders.LineStyle = 1
End With
Else
Set sht = Worksheets.Add(after:=Sheets(Sheets.Count))
With sht
.Name = mc
.[a1].Resize(1, 6) = Array("锅号", "工单批号", "型号", "等级", "入库数量", "入库时间")
.[a2].Resize(n, UBound(br, 2)) = br
.[a1].Resize(n + 1, UBound(br, 2)).Borders.LineStyle = 1
End With
End If
End If
Next j
End Sub
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-3-11 20:43
楼主