Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

数据透视表40+个常用小技巧,让你一次学会!
查看: 168|回复: 1

[已解决]帮忙将K列与L列公式用VBA代码运行

[复制链接]
发表于 2022-5-23 09:29 | 显示全部楼层 |阅读模式
搜狗截图20220523091539.png
请各位老师帮忙抽空看下,K列与L列目前得出的的结果是采用公式
要如何用VBA代码来实现呢,
自己尝试写了下代码,L列不能将结果全部计算出来
代码放在模块里,请各位老师帮忙修改下代码,或是帮忙重新写个代码,谢谢了!
最佳答案
2022-5-23 11:51

請測試看看,謝謝
Sub test()
Arr = [b1].CurrentRegion
For j = 2 To UBound(Arr)
    If j = UBound(Arr) Then Arr(j, 10) = 0: Arr(j, 11) = 0: GoTo 99
    If Arr(j, 9) = "入" And Arr(j + 1, 9) = "出" And Arr(j, 1) = Arr(j + 1, 1) Then
        Arr(j, 10) = (Arr(j + 1, 6) + Arr(j + 1, 7) - (Arr(j, 6) + Arr(j, 7))) * 1440
    Else
        Arr(j, 10) = 0
    End If

    If Arr(j, 9) = "出" And Arr(j + 1, 9) = "入" And Arr(j, 1) = Arr(j + 1, 1) Then
        Arr(j, 11) = (Arr(j + 1, 6) + Arr(j + 1, 7) - (Arr(j, 6) + Arr(j, 7))) * 1440
    Else
        Arr(j, 11) = 0
    End If
99: Next j
[b1].Resize(UBound(Arr), UBound(Arr, 2)) = Arr
End Sub

翼闸门自动报表.zip

14.51 KB, 下载次数: 2

发表于 2022-5-23 11:51 | 显示全部楼层    本楼为最佳答案   

請測試看看,謝謝
Sub test()
Arr = [b1].CurrentRegion
For j = 2 To UBound(Arr)
    If j = UBound(Arr) Then Arr(j, 10) = 0: Arr(j, 11) = 0: GoTo 99
    If Arr(j, 9) = "入" And Arr(j + 1, 9) = "出" And Arr(j, 1) = Arr(j + 1, 1) Then
        Arr(j, 10) = (Arr(j + 1, 6) + Arr(j + 1, 7) - (Arr(j, 6) + Arr(j, 7))) * 1440
    Else
        Arr(j, 10) = 0
    End If

    If Arr(j, 9) = "出" And Arr(j + 1, 9) = "入" And Arr(j, 1) = Arr(j + 1, 1) Then
        Arr(j, 11) = (Arr(j + 1, 6) + Arr(j + 1, 7) - (Arr(j, 6) + Arr(j, 7))) * 1440
    Else
        Arr(j, 11) = 0
    End If
99: Next j
[b1].Resize(UBound(Arr), UBound(Arr, 2)) = Arr
End Sub

1.JPG
回复

使用道具 举报

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

本版积分规则

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

GMT+8, 2022-8-15 11:19 , Processed in 0.174249 second(s), 9 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

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