[已解决]帮忙做改代码，改了很久没改过来！

楚雪飞扬

请各位帮忙修改下代码，红色框部份

最佳答案

月排行榜 / 总排行榜

eennoo

2022-5-27 01:20

Sub 按钮5_Click()
Dim arr As Range
Set arr = Range("A2:j8")
ReDim brr(1 To arr.Rows.Count, 1 To 2)

For r = 1 To arr.Rows.Count 'Step 2
If arr(r, "b") = arr(r + 1, "b") Then
flag = arr(r, "j") = "入" And arr(r + 1, "j") = "出"

If flag Then brr(r, 1) = (arr(r + 1, "g") + arr(r + 1, "h") - (arr(r, "g") + arr(r, "h"))) * 24 * 60

flag = arr(r, "j") = "出" And arr(r + 1, "j") = "入"
If flag Then brr(r, 2) = (arr(r + 1, "g") + arr(r + 1, "h") - (arr(r, "g") + arr(r, "h"))) * 24 * 60
End If

Next
[k2].Resize(arr.Rows.Count, 2) = brr
End Sub

跳转到最佳答案楼层

砂海

and 写很长 , 不容易判断

------------------------------------
dim 判断 as string
判断 = 判断 & iif( arr(j,9) = "出" , "①" ,"_")
判断 = 判断 & iif( arr(j+1,9) = "入" , "②" ,"_")
判断 = 判断 & iif( ... , "③" ,"_")

if 判断 = "①②③" then

=============================
这样 非常 直观 , 容易检查

楚雪飞扬

砂海 发表于 2022-5-14 00:00
and 写很长 , 不容易判断

------------------------------------

老师您好，
根据你提供的代码，尝试着自己修改，没改过来，不短简是否帮忙帮忙提供个完整的代码！

LeDuWuYe

提问题，代码分析，需说明你的目的，避免大家走弯路。

楚雪飞扬

LeDuWuYe 发表于 2022-5-22 13:31
提问题，代码分析，需说明你的目的，避免大家走弯路。

老师您好，需要将K列与L列，两的公式用代码的形式来运行，代码在模块的，麻烦帮忙抽空改下代码或是重新写个代码，谢谢！
因数据量比采用公式会造成电脑卡死！

eennoo

Sub 按钮5_Click()
Dim arr As Range
Set arr = Range("A2:j8")
ReDim brr(1 To arr.Rows.Count, 1 To 2)

For r = 1 To arr.Rows.Count 'Step 2
If arr(r, "b") = arr(r + 1, "b") Then
flag = arr(r, "j") = "入" And arr(r + 1, "j") = "出"

If flag Then brr(r, 1) = (arr(r + 1, "g") + arr(r + 1, "h") - (arr(r, "g") + arr(r, "h"))) * 24 * 60

flag = arr(r, "j") = "出" And arr(r + 1, "j") = "入"
If flag Then brr(r, 2) = (arr(r + 1, "g") + arr(r + 1, "h") - (arr(r, "g") + arr(r, "h"))) * 24 * 60
End If

Next
[k2].Resize(arr.Rows.Count, 2) = brr
End Sub