求助：制作出入库（自动化）EXCEL表

babibomb

压缩包内有一份“入库”一份“出库”数据 工作内容： 客人会不定期的下订单，每次的订单需要“入库”，工厂做好货后，会提供箱号给我，即压缩包里面的“出货表” 表格内A列的数据是不重复的，看箱号判断是否有出货， 需求： 1.将入库文件导入到一个SHEET1 2.将出库文件放到SHEET2 3.能自动生成SHEET3，未出货的数据。（要显示箱号，款号，颜色，对数）

HSIAOQIANG

這個屬於商用，免費怕是沒人做。

3190496160

Sub 导入出入库数据()
Application.ScreenUpdating = False
Dim rn As Range
lj = ThisWorkbook.Path & "\"
f = Dir(lj & "*.xls*")
Do While f <> ""
    If f <> ThisWorkbook.Name Then
        Set wb = Workbooks.Open(lj & f, 0)
        If InStr(wb.Name, "出库") > 0 Then
            Set sht = ThisWorkbook.Worksheets("出库")
            With wb.Worksheets(1)
                If sht.[a1] = "" Then
                    Set rn = .[a1].CurrentRegion
                Else
                    Set rn = .[a1].CurrentRegion.Offset(1)
                End If
            End With
            r = sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
            If r = 2 Then r = 1
            rn.Copy sht.Cells(r, 1)
            Set rn = Nothing
        ElseIf InStr(wb.Name, "入库") > 0 Then
            Set sht = ThisWorkbook.Worksheets("入库")
            With wb.Worksheets(1)
                If sht.[a1] = "" Then
                    Set rn = .[a1].CurrentRegion
                Else
                    Set rn = .[a1].CurrentRegion.Offset(1)
                End If
            End With
            r = sht.Cells(Rows.Count, 1).End(xlUp).Row + 1
            If r = 2 Then r = 1
            rn.Copy sht.Cells(r, 1)
            Set rn = Nothing
        End If
        wb.Close False
    End If
f = Dir
Loop
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

3190496160

出入库.rar (37.21 KB, 下载次数: 42)

2023-4-18 08:38 上传

点击文件名下载附件

3190496160

只写了导入的代码，而且，很多细节都是未知的，代码仅供参考
至于根据箱号匹配，出库和入库中都是有两列有箱号，不知需要用哪一列来匹配