【求助帖】如何通过输入收文登记表自动生成收文处理单，求各位大神！！！！！

huangtuban

lzqlaj 发表于 2017-4-16 11:56
要启用宏。测试一下数据，看符合要求吗？

太好了我测试一下  真的太谢谢您了 非常感谢！

huangtuban

感谢lzqlaj您的帮助，终于可以将繁杂的工作简约化，真的由衷地感谢您！

lzqlaj

不用客气。又改下，编号自动加载到下拉菜单。

huangtuban

好的，谢谢您这么细致！

huangtuban

lzqlaj 发表于 2017-4-16 12:06
不用客气。又改下，编号自动加载到下拉菜单。

还想麻烦您一下 您能教教我是怎么做到的吗？

hanzhibin119

求助大神,我打开后出现一下问题

李林1993

lzqlaj 发表于 2017-4-16 11:56
要启用宏。测试一下数据，看符合要求吗？

您好，我试着改了阅办单格式，读取数据出错，麻烦您帮助下，谢谢！WX号：18908960189

lzqlaj

Sub a()
    Dim arr, hs, k
    hs = Sheet2.Range("B65536").End(xlUp).Row
    arr = Sheet2.Range("A3:E" & hs)
    Sheet3.Range("B5") = ""
    Sheet3.Range("D5") = ""
    Sheet3.Range("D6") = ""
    Sheet3.Range("B7") = ""
    Sheet3.Range("F5") = ""
    For k = 1 To UBound(arr)
        If arr(k, 2) = Sheet3.Range("B6") Then
            Sheet3.Range("B5") = arr(k, 5)
            Sheet3.Range("D5") = arr(k, 3)
            Sheet3.Range("D6") = arr(k, 1)
            Sheet3.Range("B7") = arr(k, 4)
            Sheet3.Range("F5") = 1
            Exit For
        End If
    Next k
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Address = "$B$6" Then
        Call a
    End If
End Sub
根据”阅办单“中B6文件编号在"来文登记"中查找文件信息并填到“阅办单”,改变B6，查看对应信息。win10+excel2019 运行正常。