Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

工作中常用的Excel函数公式,全印在一张超大鼠标垫上
查看: 268|回复: 5

[已解决]求助大神,新人一个,实在不知道怎么做,想做一个文控清单

[复制链接]
发表于 2021-7-21 12:15 | 显示全部楼层 |阅读模式
具体需求请看运行要求word
最佳答案
2021-7-22 08:57
Sub wkqd() '发布表和有效表同时打开执行代码
    Dim k As Long, m As Integer, str As String, adr, strBH As Byte
    On Error Resume Next
    Workbooks("发布表").Activate
    k = Sheets("分发总清单").Cells(Rows.Count, 1).End(3).Row + 1
    Sheets("每次分发").Activate
    Range("a2:j" & Cells(Rows.Count, 1).End(3).Row).Select
    Selection.Copy Sheets("分发总清单").Range("a" & k)
    For m = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
        str = Cells(m, 2).Text
        strBH = InStr(Cells(m, 6), "/")
        If strBH > 1 Then
            If InStr(Cells(m, 2), "JL") > 0 Then
                Workbooks("有效表").Activate
                Sheets("记录清单").Activate
                Columns("b:b").Find(what:=str).Select
                adr = Selection.Row
                Workbooks("发布表").Sheets("每次分发").Rows(m).Copy Range("a" & adr)
            Else
                Workbooks("有效表").Activate
                Sheets("文件清单").Activate
                Columns("b:b").Find(what:=str).Select
                adr = Selection.Row
                Workbooks("发布表").Sheets("每次分发").Rows(m).Copy Range("a" & adr)
            End If
        Else
            If InStr(Cells(m, 2), "JL") > 0 Then
                Workbooks("有效表").Activate
                Sheets("作废记录").Activate
                adr = Range("b65536").End(3).Row + 1
                Workbooks("发布表").Sheets("每次分发").Rows(m).Copy Range("a" & adr)
                Workbooks("发布表").Sheets("每次分发").Rows(m).Delete
            Else
                Workbooks("有效表").Activate
                Sheets("作废文件").Activate
                adr = Range("b65536").End(3).Row + 1
                Workbooks("发布表").Sheets("每次分发").Rows(m).Copy Range("a" & adr)
                Workbooks("发布表").Sheets("每次分发").Rows(m).Delete
            End If
        End If
        Workbooks("发布表").Activate
        Sheets("每次分发").Activate
    Next m
End Sub

Desktop.zip

22.12 KB, 下载次数: 6

excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
发表于 2021-7-21 19:13 | 显示全部楼层
回复

使用道具 举报

发表于 2021-7-22 08:57 | 显示全部楼层    本楼为最佳答案   
Sub wkqd() '发布表和有效表同时打开执行代码
    Dim k As Long, m As Integer, str As String, adr, strBH As Byte
    On Error Resume Next
    Workbooks("发布表").Activate
    k = Sheets("分发总清单").Cells(Rows.Count, 1).End(3).Row + 1
    Sheets("每次分发").Activate
    Range("a2:j" & Cells(Rows.Count, 1).End(3).Row).Select
    Selection.Copy Sheets("分发总清单").Range("a" & k)
    For m = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
        str = Cells(m, 2).Text
        strBH = InStr(Cells(m, 6), "/")
        If strBH > 1 Then
            If InStr(Cells(m, 2), "JL") > 0 Then
                Workbooks("有效表").Activate
                Sheets("记录清单").Activate
                Columns("b:b").Find(what:=str).Select
                adr = Selection.Row
                Workbooks("发布表").Sheets("每次分发").Rows(m).Copy Range("a" & adr)
            Else
                Workbooks("有效表").Activate
                Sheets("文件清单").Activate
                Columns("b:b").Find(what:=str).Select
                adr = Selection.Row
                Workbooks("发布表").Sheets("每次分发").Rows(m).Copy Range("a" & adr)
            End If
        Else
            If InStr(Cells(m, 2), "JL") > 0 Then
                Workbooks("有效表").Activate
                Sheets("作废记录").Activate
                adr = Range("b65536").End(3).Row + 1
                Workbooks("发布表").Sheets("每次分发").Rows(m).Copy Range("a" & adr)
                Workbooks("发布表").Sheets("每次分发").Rows(m).Delete
            Else
                Workbooks("有效表").Activate
                Sheets("作废文件").Activate
                adr = Range("b65536").End(3).Row + 1
                Workbooks("发布表").Sheets("每次分发").Rows(m).Copy Range("a" & adr)
                Workbooks("发布表").Sheets("每次分发").Rows(m).Delete
            End If
        End If
        Workbooks("发布表").Activate
        Sheets("每次分发").Activate
    Next m
End Sub
回复

使用道具 举报

 楼主| 发表于 2021-7-22 12:16 | 显示全部楼层
风林火山 发表于 2021-7-22 08:57
Sub wkqd() '发布表和有效表同时打开执行代码
    Dim k As Long, m As Integer, str As String, adr, str ...

谢谢大神,基本满足使用,只不过有个地方我没有表述清楚,如果在发布表每次分发中遇见如下
20210708bB-JL-123457BBBBBA/9
2021/7/16
/NY
77777
,需要在有效表中删去对应编号的(B-JL-123457这个编号原本是在有效表中有效记录中的),如果满足“/”删去要求,就把有效表中记录清单中的(B-JL-123457这个编号)的信息删去,并把这个信息记录在有效表作废记录里面。我先改改代码,如果不行,还请大神多多指教。现在这里谢谢大神给予的帮助。
回复

使用道具 举报

发表于 2021-7-22 13:58 | 显示全部楼层
Sub wkqd() '发布表和有效表同时打开执行代码
    Dim k As Long, m As Integer, str As String, adr, strBH As Byte
    On Error Resume Next
    Workbooks("发布表").Activate
    k = Sheets("分发总清单").Cells(Rows.Count, 1).End(3).Row + 1
    Sheets("每次分发").Activate
    For m = Cells(Rows.Count, 1).End(3).Row To 2 Step -1
        str = Cells(m, 2).Text
        strBH = Len(Cells(m, 6))
        If strBH = 5 Then
            If InStr(Cells(m, 2), "JL") > 0 Then
                Workbooks("有效表").Activate
                Sheets("记录清单").Activate
                Columns("b:b").Find(what:=str).Select
                adr = Selection.Row
                Workbooks("发布表").Sheets("每次分发").Rows(m).Copy Range("a" & adr)
            Else
                Workbooks("有效表").Activate
                Sheets("文件清单").Activate
                Columns("b:b").Find(what:=str).Select
                adr = Selection.Row
                Workbooks("发布表").Sheets("每次分发").Rows(m).Copy Range("a" & adr)
            End If
        Else
            If InStr(Cells(m, 2), "JL") > 0 Then
                Workbooks("有效表").Activate
                Sheets("作废记录").Activate
                adr = Range("b65536").End(3).Row + 1
                Workbooks("发布表").Sheets("每次分发").Rows(m).Copy Range("a" & adr)
                Workbooks("发布表").Sheets("每次分发").Rows(m).Delete
            Else
                Workbooks("有效表").Activate
                Sheets("作废文件").Activate
                adr = Range("b65536").End(3).Row + 1
                Workbooks("发布表").Sheets("每次分发").Rows(m).Copy Range("a" & adr)
                Workbooks("发布表").Sheets("每次分发").Rows(m).Delete
            End If
        End If
        Workbooks("发布表").Activate
        Sheets("每次分发").Activate
    Next m
    Range("a2:j" & Cells(Rows.Count, 1).End(3).Row).Select
    Selection.Copy Sheets("分发总清单").Range("a" & k)

End Sub

回复

使用道具 举报

 楼主| 发表于 2021-7-24 11:54 | 显示全部楼层
风林火山 发表于 2021-7-22 13:58
Sub wkqd() '发布表和有效表同时打开执行代码
    Dim k As Long, m As Integer, str As String, adr, str ...

大神,这是运行逻辑

运行逻辑.zip

192.36 KB, 下载次数: 2

运行逻辑

回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2021-9-16 18:25 , Processed in 0.558734 second(s), 10 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表