仓库出库再加批注

ok520

各位好
想看看能否用VBA对仓库出库时加批注，

先讲一下求助内容

将“出库记录表”的关键项（黄色），

匹配后面的“7月物料存储明细表”*日期是按单元格列来排列的。

按照物料编号 与 出库日期 录入“出库表”的数量，并且在相对的单元格插入相关的批注也就是“出库记录表”的出库单号

谢谢大家抽空思考和关注

出库表.rar (5.26 KB, 下载次数: 31)

2014-7-26 17:48 上传

点击文件名下载附件

ok520

每天顶自己的贴，快乐又补铁

SycoVictor

1. Sub test()
   
2.     Dim i&, j&
   
3.     Application.ScreenUpdating = False
   
4.     For i = 2 To Cells(65536, 1).End(3).Row
   
5.         With Worksheets(2)
   
6.             For j = 2 To .Cells(65536, 1).End(3).Row
   
7.                 If Cells(i, 10) = .Cells(j, 2) Then
   
8.                     .Cells(j, 43 + Int(Right(Cells(i, 2), 2))) = Cells(i, 6)
   
9.                     .Cells(j, 43 + Int(Right(Cells(i, 2), 2))).NoteText Cells(i, 1)
   
10.                 End If
    
11.             Next
    
12.         End With
    
13.     Next
    
14.     Application.ScreenUpdating = True
    
15. End Sub
    

复制代码

补铁的来了。

ok520

SycoVictor 发表于 2014-7-27 08:41
补铁的来了。

谢谢 SycoVictor哥

不好意思，再无耻的追加点功能
"出库记录表"与这个“7月物料存储明细表”不在一个文件里面，

因为我有很多"出库记录表"需要导到明细表里

可以帮我加一个窗口吗？

SycoVictor

不客气。
这样，你先做两个“出库记录表”和一个“7月物料储存明细表”，然后大概手工模拟下结果。
将这三个文件打包上传。这样我可以帮你再改进一下。

ok520

SycoVictor 发表于 2014-7-27 12:15
不客气。
这样，你先做两个“出库记录表”和一个“7月物料储存明细表”，然后大概手工模拟下结果。
将这三 ...

三天的出库订单
20140724.xls
20140725.xls
20140726.xls


汇总表
7月物料存储明细表.xls

真感谢您在炎炎夏日面对，那无情的电脑。。。

批量导入表.rar (21.82 KB, 下载次数: 8)

2014-7-27 12:33 上传

点击文件名下载附件

SycoVictor

1. Sub test()
   
2.     Dim i&, j&
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     With GetObject(ThisWorkbook.path & "" & Cells(1, 1) & ".xls")
   
6.         For i = 2 To .Worksheets(1).Cells(65536, 1).End(3).Row
   
7.                 For j = 2 To Worksheets(2).Cells(65536, 1).End(3).Row
   
8.                     If .Worksheets(1).Cells(i, 10) = Worksheets(2).Cells(j, 2) Then
   
9.                         Worksheets(2).Cells(j, 43 + Int(Right(.Worksheets(1).Cells(i, 2), 2))) = .Worksheets(1).Cells(i, 6)
   
10.                         Worksheets(2).Cells(j, 43 + Int(Right(.Worksheets(1).Cells(i, 2), 2))).NoteText .Worksheets(1).Cells(i, 1)
    
11.                     End If
    
12.                 Next
    
13.         Next
    
14.         .IsAddin = True
    
15.         .IsAddin = False
    
16.         .Close True
    
17.     End With
    
18.     Application.DisplayAlerts = True
    
19.     Application.ScreenUpdating = True
    
20. End Sub
    

复制代码

试试这样行不行。

ok520

SycoVictor 发表于 2014-7-27 18:18
试试这样行不行。

但是如果遇到物料编号，供应商编号都一样

订单数量可以求和并且录入吗？

20140731.rar (2.53 KB, 下载次数: 8)

2014-7-28 23:12 上传

点击文件名下载附件

SycoVictor

1. Sub test()
   
2.     Dim i&
   
3.     Application.ScreenUpdating = False
   
4.     Application.DisplayAlerts = False
   
5.     With GetObject(ThisWorkbook.path & "" & Cells(1, 1) & ".xls")
   
6.         Range(Worksheets(2).Cells(4, 43 + Int(Right(Worksheets(1).Cells(1, 1), 2))), Worksheets(2).Cells(4, 43 + Int(Right(Worksheets(1).Cells(1, 1), 2))).End(3).Offset(1, 0)).ClearContents
   
7.         For i = 2 To .Worksheets(1).Cells(65536, 1).End(3).Row
   
8.             For j = 2 To Worksheets(2).Cells(65536, 1).End(3).Row
   
9.                 If .Worksheets(1).Cells(i, 10) = Worksheets(2).Cells(j, 2) Then
   
10.                     Worksheets(2).Cells(j, 43 + Int(Right(.Worksheets(1).Cells(i, 2), 2))) = Worksheets(2).Cells(j, 43 + Int(Right(.Worksheets(1).Cells(i, 2), 2))) + .Worksheets(1).Cells(i, 6)
    
11.                     Worksheets(2).Cells(j, 43 + Int(Right(.Worksheets(1).Cells(i, 2), 2))).NoteText .Worksheets(1).Cells(i, 1)
    
12.                 End If
    
13.             Next
    
14.         Next
    
15.         .IsAddin = True
    
16.         .IsAddin = False
    
17.         .Close True
    
18.     End With
    
19.     Application.DisplayAlerts = True
    
20.     Application.ScreenUpdating = True
    
21. End Sub
    

复制代码

这样行不行。

ok520

SycoVictor 发表于 2014-7-29 00:16
这样行不行。

批注可否加上总装出库数呢？如果合并了，那是否有两个批注?

Sub test()
    Dim i&
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With GetObject(ThisWorkbook.path & "\" & Cells(1, 1) & ".xls")
        Range(Worksheets(2).Cells(4, 43 + Int(Right(Worksheets(1).Cells(1, 1), 2))), Worksheets(2).Cells(4, 43 + Int(Right(Worksheets(1).Cells(1, 1), 2))).End(3).Offset(1, 0)).ClearContents
        For i = 2 To .Worksheets(1).Cells(65536, 1).End(3).Row
            For j = 2 To Worksheets(2).Cells(65536, 1).End(3).Row
                If .Worksheets(1).Cells(i, 10) = Worksheets(2).Cells(j, 2) Then
                    Worksheets(2).Cells(j, 43 + Int(Right(.Worksheets(1).Cells(i, 2), 2))) = Worksheets(2).Cells(j, 43 + Int(Right(.Worksheets(1).Cells(i, 2), 2))) + .Worksheets(1).Cells(i, 6)
                    Worksheets(2).Cells(j, 43 + Int(Right(.Worksheets(1).Cells(i, 2), 2))).Comment.Text Text = "Worksheets(1).Cells(i, 1) & Worksheets(1).Cells(i, 3)"
                End If
            Next
        Next
        .IsAddin = True
        .IsAddin = False
        .Close True
    End With
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub