求个大佬解答帮帮忙数据对应填写该咋弄

fxd1151873874

老师请教了 麻烦一下了

ykcbf1100

汇总表只提取B~F列数据？

ykcbf1100

求助时多少说几句啊，让写代码的人去猜有意思吗？

wfywc81

用ChatGPT1分钟写的代码，我猜的你的需求，不知道是否正确，请查收！

3190496160

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

3190496160

日报表.rar (41.86 KB, 下载次数: 4)

2024-3-12 10:35 上传

点击文件名下载附件

fxd1151873874

ykcbf1100 发表于 2024-3-11 21:20
求助时多少说几句啊，让写代码的人去猜有意思吗？

刚看到老师麻烦您了

fxd1151873874

wfywc81 发表于 2024-3-11 23:19
用ChatGPT1分钟写的代码，我猜的你的需求，不知道是否正确，请查收！

谢谢老师，还真就是这个意思

fxd1151873874

3190496160 发表于 2024-3-12 10:36

谢谢您老师，您这个也很好