求大神帮忙用VBA实现个人明细显示

蝴蝶兰2017

参考其他办公用品管理的表格，自己用公式做的管理系统。现在需要增加一个《个人明细表》，方便人员离职时，可以一目了然地看到其物品领用的记录。要求实现，在姓名栏后的单元格里通过下拉菜单选择人员后，可以在下面的表格里自动显示，与这个人有关的领用归还记录。求各路大神，帮忙用VBA实现这一功能吧。谢谢！ 办公用品管理台账.rar (203.76 KB, 下载次数: 11)

2018-8-10 11:30 上传

点击文件名下载附件

蝴蝶兰2017

朱荣兴 发表于 2018-8-10 12:16
Private Sub Worksheet_Change(ByVal T As Range)
If T.Address  "$C$2" Then Exit Sub
arr = Sheets("出 ...

大神能给注释下吗？我是新手，想学习来着，

蝴蝶兰2017

蝴蝶兰2017 发表于 2018-8-10 14:45
大神能给注释下吗？我是新手，想学习来着，

刚刚又仔细试了下，发现，这个只能实现个人领用的那部分信息可以自动显示出来，而个人归还的那部分信息则不显示，能不能同时显示出这个人的所有信息呢（即领了多少东西，归还多少东西，显示在同一张表格里）？

lsc900707

蝴蝶兰2017 发表于 2018-8-10 15:25
刚刚又仔细试了下，发现，这个只能实现个人领用的那部分信息可以自动显示出来，而个人归还的那部分信息则 ...

个人感觉出入库登记表有点问题，按我理解，有出库，保管人即为领用人；有入库则保管人为仓管员。

lsc900707

1. Private Sub Worksheet_Change(ByVal T As Range)
   
2.     If T.Row = 2 And T.Column = 3 Then
   
3.         arr = Sheet7.[a1].CurrentRegion
   
4.         ReDim brr(1 To UBound(arr), 1 To 10)
   
5.         For i = 3 To UBound(arr)
   
6.             If arr(i, 8) = T.Value Or arr(i, 9) = T.Value Then
   
7.                 m = m + 1
   
8.                 brr(m, 1) = n
   
9.                 For j = 2 To 6
   
10.                    brr(m, j) = arr(i, j - 1)
    
11.                 Next
    
12.                 brr(m, 7) = arr(i, 7)
    
13.                 brr(m, 8) = arr(i, 6)
    
14.                 brr(m, 10) = arr(i, 12)
    
15.                 If Len(arr(i, 6)) = 0 And Len(arr(i, 7)) Then
    
16.                      brr(m, 9) = arr(i, 9)
    
17.                 Else
    
18.                     brr(m, 9) = arr(i, 10)
    
19.                 End If
    
20.             End If
    
21.         Next
    
22.         If m Then
    
23.             [a1].CurrentRegion.Offset(3).ClearContents
    
24.             [a4].Resize(m, 10) = brr
    
25.         End If
    
26.     End If
    
27. End Sub

复制代码

lsc900707

按我的理解写的，不知是否如此，请测试附件：

蝴蝶兰2017

lsc900707 发表于 2018-8-10 16:28
按我的理解写的，不知是否如此，请测试附件：

辛苦了，谢谢。不过这段代码表达的是什么意思呢?
If Len(arr(i, 6)) = 0 And Len(arr(i, 7)) Then
                     brr(m, 9) = arr(i, 9)
                Else
                    brr(m, 9) = arr(i, 10)
                End If
我根据我自己的理解修改了一下代码，效果还可以。Private Sub Worksheet_Change(ByVal T As Range)
    If T.Row = 2 And T.Column = 3 Then
        arr = Sheet7.[a1].CurrentRegion
        ReDim brr(1 To UBound(arr), 1 To 10)
        For i = 3 To UBound(arr)
            If arr(i, 8) = T.Value Or arr(i, 9) = T.Value Then
                m = m + 1
                brr(m, 1) = n
                For j = 2 To 6
                   brr(m, j) = arr(i, j - 1)
                Next
                brr(m, 7) = arr(i, 6)
                brr(m, 8) = arr(i, 7)
                brr(m, 9) = arr(i, 10)
                brr(m, 10) = arr(i, 12)
            End If
        Next
        If m Then
            [a1].CurrentRegion.Offset(3).ClearContents
            [a4].Resize(m, 10) = brr
        End If
    End If
End Sub

其中：If m Then
            [a1].CurrentRegion.Offset(3).ClearContents
            [a4].Resize(m, 10) = brr
        End If
这段代码也不是很明白，求解答

蝴蝶兰2017

lsc900707 发表于 2018-8-10 16:23
个人感觉出入库登记表有点问题，按我理解，有出库，保管人即为领用人；有入库则保管人为仓管员。

出库，没有保管人，只有领用人；入库，有交库人（也可以是采购人），保管人为仓管员

lsc900707

蝴蝶兰2017 发表于 2018-8-10 17:57
辛苦了，谢谢。不过这段代码表达的是什么意思呢?
If Len(arr(i, 6)) = 0 And Len(arr(i, 7)) Then
    ...

很好理解的呀，如果有合乎条件的数据即把原来的查询结果清除，再显示新的查询结果。