Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

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

[已解决]求助,这个代码要怎么写

[复制链接]
发表于 2021-7-24 11:57 | 显示全部楼层 |阅读模式
运行逻辑如下附件PPT,要怎么处理。
最佳答案
2021-7-27 10:51
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("每次分发").Cells(m, 2).Resize(1, 5).Copy Range("b" & adr)
            Else
                Workbooks("有效表").Activate
                Sheets("文件清单").Activate
                Columns("b:b").Find(what:=str).Select
                adr = Selection.Row
                Workbooks("发布表").Sheets("每次分发").Cells(m, 2).Resize(1, 5).Copy Range("b" & adr)
            End If
        Else
            If InStr(Cells(m, 2), "JL") > 0 Then
                Workbooks("有效表").Activate
                Sheets("记录清单").Activate
                Columns("b:b").Find(what:=str).Select
                ActiveCell.EntireRow.Delete
                Sheets("作废记录").Activate
                adr = Range("b65536").End(3).Row + 1
                Workbooks("发布表").Sheets("每次分发").Cells(m, 2).Resize(1, 3).Copy Range("b" & adr)
                Cells(adr, 7) = Date & "删除" & Workbooks("发布表").Sheets("每次分发").Cells(m, 1)
                Workbooks("发布表").Sheets("每次分发").Rows(m).Delete
            Else
                Workbooks("有效表").Activate
                Sheets("文件清单").Activate
                Columns("b:b").Find(what:=str).Select
                ActiveCell.EntireRow.Delete
                Sheets("作废文件").Activate
                adr = Range("b65536").End(3).Row + 1
                Workbooks("发布表").Sheets("每次分发").Cells(m, 2).Resize(1, 3).Copy Range("b" & adr)
                Cells(adr, 7) = Date & "删除" & Workbooks("发布表").Sheets("每次分发").Cells(m, 1)
                Workbooks("发布表").Sheets("每次分发").Rows(m).Delete
            End If
        End If
        Workbooks("发布表").Activate
        Sheets("每次分发").Activate
    Next m
End Sub

运行逻辑.zip

192.36 KB, 下载次数: 14

发表于 2021-7-25 11:32 | 显示全部楼层
唉!
一开始以为你要做PPT文件 的VBA编程,
原来PPT是个说明文件,还是EXCEL文件的VBA。

你的PPT说明文件真的是图文并茂,可是本人实在是笨,没看懂!
等高手来解决吧!
回复

使用道具 举报

发表于 2021-7-25 21:29 | 显示全部楼层
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("每次分发").Cells(m, 2).Resize(1, 5).Copy Range("b" & adr)
            Else
                Workbooks("有效表").Activate
                Sheets("文件清单").Activate
                Columns("b:b").Find(what:=str).Select
                adr = Selection.Row
                Workbooks("发布表").Sheets("每次分发").Cells(m, 2).Resize(1, 5).Copy Range("b" & 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("每次分发").Cells(m, 2).Resize(1, 3).Copy Range("b" & adr)
                Cells(adr, 7) = Date & "删除" & Workbooks("发布表").Sheets("每次分发").Cells(m, 1)
            Else
                Workbooks("有效表").Activate
                Sheets("作废文件").Activate
                adr = Range("b65536").End(3).Row + 1
                Workbooks("发布表").Sheets("每次分发").Cells(m, 2).Resize(1, 3).Copy Range("b" & adr)
                Cells(adr, 7) = Date & "删除" & Workbooks("发布表").Sheets("每次分发").Cells(m, 1)
            End If
        End If
        Workbooks("发布表").Activate
        Sheets("每次分发").Activate
    Next m
End Sub
回复

使用道具 举报

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

Else
            If InStr(Cells(m, 2), "JL") > 0 Then
                Workbooks("有效表").Activate
                Sheets("作废记录").Activate
                adr = Range("b65536").End(3).Row + 1
                Workbooks("发布表").Sheets("每次分发").Cells(m, 2).Resize(1, 3).Copy Range("b" & adr)
                Cells(adr, 7) = Date & "删除" & Workbooks("发布表").Sheets("每次分发").Cells(m, 1)                这个地方还差删除,有效表,记录清单对应的行所有数据的代码
            Else
                Workbooks("有效表").Activate
                Sheets("作废文件").Activate
                adr = Range("b65536").End(3).Row + 1
                Workbooks("发布表").Sheets("每次分发").Cells(m, 2).Resize(1, 3).Copy Range("b" & adr)
                Cells(adr, 7) = Date & "删除" & Workbooks("发布表").Sheets("每次分发").Cells(m, 1)
                这个地方还差删除,有效表,文件清单对应的行所有数据的代码
            End If
        End If
        Workbooks("发布表").Activate
        Sheets("每次分发").Activate
    Next m
End Sub

回复

使用道具 举报

发表于 2021-7-27 08:53 | 显示全部楼层
记录清单中有这个数据吗?这个数据是怎么进去的?手动输入的还是?
回复

使用道具 举报

 楼主| 发表于 2021-7-27 09:59 | 显示全部楼层
风林火山 发表于 2021-7-27 08:53
记录清单中有这个数据吗?这个数据是怎么进去的?手动输入的还是?

可以理解为,以前输进去的,现在这个文件作废了,需要在记录清单里面删去,并把作废的信息记录在作废记录里面。分发表每次分发其实就是发布的文件信息,遇见“/”就代表这个文件作废了,这个作废文件原来是位于有效表中(可以看做是以前的每次分发加进去的),那就需要在有效表中把这个文件删去,并把文件信息,以及删去信息记录在作废文件中。
回复

使用道具 举报

发表于 2021-7-27 10:51 | 显示全部楼层    本楼为最佳答案   
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("每次分发").Cells(m, 2).Resize(1, 5).Copy Range("b" & adr)
            Else
                Workbooks("有效表").Activate
                Sheets("文件清单").Activate
                Columns("b:b").Find(what:=str).Select
                adr = Selection.Row
                Workbooks("发布表").Sheets("每次分发").Cells(m, 2).Resize(1, 5).Copy Range("b" & adr)
            End If
        Else
            If InStr(Cells(m, 2), "JL") > 0 Then
                Workbooks("有效表").Activate
                Sheets("记录清单").Activate
                Columns("b:b").Find(what:=str).Select
                ActiveCell.EntireRow.Delete
                Sheets("作废记录").Activate
                adr = Range("b65536").End(3).Row + 1
                Workbooks("发布表").Sheets("每次分发").Cells(m, 2).Resize(1, 3).Copy Range("b" & adr)
                Cells(adr, 7) = Date & "删除" & Workbooks("发布表").Sheets("每次分发").Cells(m, 1)
                Workbooks("发布表").Sheets("每次分发").Rows(m).Delete
            Else
                Workbooks("有效表").Activate
                Sheets("文件清单").Activate
                Columns("b:b").Find(what:=str).Select
                ActiveCell.EntireRow.Delete
                Sheets("作废文件").Activate
                adr = Range("b65536").End(3).Row + 1
                Workbooks("发布表").Sheets("每次分发").Cells(m, 2).Resize(1, 3).Copy Range("b" & adr)
                Cells(adr, 7) = Date & "删除" & Workbooks("发布表").Sheets("每次分发").Cells(m, 1)
                Workbooks("发布表").Sheets("每次分发").Rows(m).Delete
            End If
        End If
        Workbooks("发布表").Activate
        Sheets("每次分发").Activate
    Next m
End Sub
回复

使用道具 举报

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

谢谢大神
回复

使用道具 举报

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

大神,今天突然发现,发布表执行VBA,而有效表不执行VBA代码,昨天还好好的,今天突然这样了。(今天装了个visio,用软件激活了下,不知道是不是这个原因)
回复

使用道具 举报

发表于 2021-8-17 15:53 | 显示全部楼层
龙魂 发表于 2021-8-17 14:27
大神,今天突然发现,发布表执行VBA,而有效表不执行VBA代码,昨天还好好的,今天突然这样了。(今天装了 ...

应该不会是这个原因吧,你多试下
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2021-9-16 19:58 , Processed in 0.415935 second(s), 11 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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