[已解决]请高手帮我修改下进出存代码谢谢

tkggss

Private Sub Worksheet_Activate()
    Dim ARR, BRR, CRR, W%, I%, J%, O%, P%
    On Error GoTo 10
    ActiveSheet.Unprotect
    Sheets("库存").Range("A4:M" & Sheets("库存").Range("A65536").End(3).Row + 2).ClearContents
    ARR = Sheets("数据").Range("A2:F" & Sheets("数据").Range("A65536").End(3).Row)
    W = UBound(ARR)
    ReDim BRR(1 To W, 1 To 13)
    ReDim CRR(1 To W, 1 To 13)
    For I = 1 To W
    For O = 1 To W
    For J = 1 To 5
    For P = 1 To 5
    BRR(I, J) = ARR(I, J)
    CRR(O, P) = ARR(I, J)
    Next
    Next
    Next
    Next
    ARR = Sheets("入库").Range("A2:E" & Sheets("入库").Range("E65536").End(3).Row)
    CRR = Sheets("出库").Range("A2:E" & Sheets("出库").Range("E65536").End(3).Row)
    For I = 1 To UBound(ARR)
    For J = 1 To W
    If ARR(I, 1) = BRR(J, 1) Then
    BRR(J, 7) = BRR(J, 7) + ARR(I, 5) '入库数量(7:库存,5:入库)
    CRR(J, 9) = BRR(J, 9) + ARR(I, 5) '出库数量(9:库存,8:入库)
    End If
    Next
    Next
    For I = 1 To W
    BRR(I, 11) = BRR(I, 5) + BRR(I, 7) - BRR(I, 9) '库存数量(5:入库初数+7:入库数量-9:入库数量)
    Next
    Range("A3:A" & Range("A65536").End(3).Row).AutoFilter
    Sheets("库存").Range("A4").Resize(W, 13) = BRR
    Range("A3:A" & Range("A65536").End(3).Row).AutoFilter
10      ActiveSheet.Protect
End Sub

最佳答案

月排行榜 / 总排行榜

zjdh

2012-9-25 14:41

Private Sub Worksheet_Activate()
    Dim ARR, BRR, CRR, W%, I%, J%, K%
    On Error GoTo 10
    ActiveSheet.Unprotect
    Sheets("库存").Range("A4:H" & Sheets("库存").Range("A65536").End(3).Row + 2).ClearContents
    ARR = Sheets("数据").Range("A2:H" & Sheets("数据").Range("A65536").End(3).Row)
    W = UBound(ARR)
    BRR = Sheets("入库").Range("A2:E" & Sheets("入库").Range("E65536").End(3).Row)
    CRR = Sheets("出库").Range("A2:E" & Sheets("出库").Range("E65536").End(3).Row)
    For I = 1 To W
        For J = 1 To UBound(BRR)
            If ARR(I, 1) = BRR(J, 1) Then
                ARR(I, 6) = ARR(I, 6) + BRR(J, 5)    '入库数量
            End If
        Next
        For K = 1 To UBound(CRR)
            If ARR(I, 1) = CRR(K, 1) Then
                ARR(I, 7) = ARR(I, 7) + CRR(K, 5)    '出库数量
            End If
        Next
    Next
    For I = 1 To W
        ARR(I, 8) = ARR(I, 5) + ARR(I, 6) - ARR(I, 7)    '库存数量
    Next
    Range("A3:A" & Range("A65536").End(3).Row).AutoFilter
    Sheets("库存").Range("A4").Resize(W, 8) = ARR
    Range("A3:A" & Range("A65536").End(3).Row).AutoFilter
10  ActiveSheet.Protect
End Sub
出入库.rar (15.2 KB, 下载次数: 5)

2012-9-25 14:41 上传

点击文件名下载附件

跳转到最佳答案楼层

zjdh

Private Sub Worksheet_Activate()
    Dim ARR, BRR, CRR, W%, I%, J%, K%
    On Error GoTo 10
    ActiveSheet.Unprotect
    Sheets("库存").Range("A4:H" & Sheets("库存").Range("A65536").End(3).Row + 2).ClearContents
    ARR = Sheets("数据").Range("A2:H" & Sheets("数据").Range("A65536").End(3).Row)
    W = UBound(ARR)
    BRR = Sheets("入库").Range("A2:E" & Sheets("入库").Range("E65536").End(3).Row)
    CRR = Sheets("出库").Range("A2:E" & Sheets("出库").Range("E65536").End(3).Row)
    For I = 1 To W
        For J = 1 To UBound(BRR)
            If ARR(I, 1) = BRR(J, 1) Then
                ARR(I, 6) = ARR(I, 6) + BRR(J, 5)    '入库数量
            End If
        Next
        For K = 1 To UBound(CRR)
            If ARR(I, 1) = CRR(K, 1) Then
                ARR(I, 7) = ARR(I, 7) + CRR(K, 5)    '出库数量
            End If
        Next
    Next
    For I = 1 To W
        ARR(I, 8) = ARR(I, 5) + ARR(I, 6) - ARR(I, 7)    '库存数量
    Next
    Range("A3:A" & Range("A65536").End(3).Row).AutoFilter
    Sheets("库存").Range("A4").Resize(W, 8) = ARR
    Range("A3:A" & Range("A65536").End(3).Row).AutoFilter
10  ActiveSheet.Protect
End Sub
出入库.rar (15.2 KB, 下载次数: 5)

2012-9-25 14:41 上传

点击文件名下载附件

tkggss

zjdh 发表于 2012-9-25 14:41
Private Sub Worksheet_Activate()
    Dim ARR, BRR, CRR, W%, I%, J%, K%
    On Error GoTo 10

谢谢你的回复，我修改了下表格,但库存内的数据不能更新，麻烦你能不能我帮在修改下数据。谢谢

zjdh

tkggss 发表于 2012-9-29 10:24
谢谢你的回复，我修改了下表格,但库存内的数据不能更新，麻烦你能不能我帮在修改下数据。谢谢

出入库.rar (13.97 KB, 下载次数: 6)

2012-10-7 08:10 上传

点击文件名下载附件