manbet网

 找回密码
 注册

QQ登录

只需一步,快速开始

188bet
查看: 121|回复: 4
打印 上一主题 下一主题

[已解决]求助一个快速对比并返回的代码

[复制链接]
跳转到指定楼层
1楼
发表于 2021-3-24 16:12 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
3学分
H2以前的公式是:如果h8 = 0 or h8 = 1 or h8 > 400,则为空,然后h8 >= h7 并且h8 >="断断"的h7:h8,则返回 "有".
h3以前的公式是:如果h8 = 0 or h8 = 1 or h8 > 400,则为空,然后h8 >= h7的值+1 并且h8 >="断断"的h7:h8的值+1,则返回 "有".
h4以前的公式是:如果h8 = 0 or h8 = 1 or h8 > 400,则为空,然后h8 >= h7的值+2 并且h8 >="断断"的h7:h8的值+2,则返回 "有".
经过多次检查,这个简单的公式导致了打开工作簿的过程太慢,老师能不能帮我用数组或字典这种快速返回的代码写一下.
范围就是H2:P2,H3:P3,H4:P4;
后面的工作表也是同样的模式,都只是引用"断断"这个表."断断"表的范围内引用其自身的位置.共有断断,1.2.3....20个表,这里因为容量问题,就显示了4个.



最佳答案
2021-3-24 16:12
Sub test()
    Dim arrData, arrResult, arrList
    Dim k, i, j
    arrList = Sheets("断断").Range("h7:p8").Value
    For k = 1 To 3
        With Sheets(CStr(k))
            arrData = .Range("h7:p8").Value
            ReDim arrResult(0 To 2, 1 To UBound(arrData, 2))
            For j = 1 To UBound(arrData, 2)
                For i = 0 To 2
                    If arrData(2, j) = 1 Or arrData(2, j) = 0 Or arrData(2, j) > 400 Then
                        arrResult(i, j) = ""
                    Else
                        If arrData(2, j) >= arrData(1, j) + i Then
                            If arrData(2, j) >= arrList(1, j) + i And arrData(2, j) >= arrList(2, j) + i Then
                                arrResult(i, j) = "有"
                            End If
                        End If
                    End If
                Next i
            Next j
            .Range("h2").Resize(UBound(arrResult) + 1, UBound(arrResult, 2)) = arrResult
        End With
    Next k
End Sub

求助.rar

243.82 KB, 下载次数: 3

最佳答案

查看完整内容

Sub test() Dim arrData, arrResult, arrList Dim k, i, j arrList = Sheets("断断").Range("h7:p8").Value For k = 1 To 3 With Sheets(CStr(k)) arrData = .Range("h7:p8").Value ReDim arrResult(0 To 2, 1 To UBound(arrData, 2)) For j = 1 To UBound(arrData, 2) For i = 0 To 2 If arrData(2, j) = 1 Or arrDa ...
分享到:  QQ好友和群QQ好友和群
收藏收藏
2楼
发表于 2021-3-24 16:12 | 只看该作者    本楼为最佳答案   
Sub test()
    Dim arrData, arrResult, arrList
    Dim k, i, j
    arrList = Sheets("断断").Range("h7:p8").Value
    For k = 1 To 3
        With Sheets(CStr(k))
            arrData = .Range("h7:p8").Value
            ReDim arrResult(0 To 2, 1 To UBound(arrData, 2))
            For j = 1 To UBound(arrData, 2)
                For i = 0 To 2
                    If arrData(2, j) = 1 Or arrData(2, j) = 0 Or arrData(2, j) > 400 Then
                        arrResult(i, j) = ""
                    Else
                        If arrData(2, j) >= arrData(1, j) + i Then
                            If arrData(2, j) >= arrList(1, j) + i And arrData(2, j) >= arrList(2, j) + i Then
                                arrResult(i, j) = "有"
                            End If
                        End If
                    End If
                Next i
            Next j
            .Range("h2").Resize(UBound(arrResult) + 1, UBound(arrResult, 2)) = arrResult
        End With
    Next k
End Sub

求助.rar

537.99 KB, 下载次数: 1

3楼
 楼主| 发表于 2021-3-25 09:54 | 只看该作者
shuidisyy 发表于 2021-3-24 16:12
Sub test()
    Dim arrData, arrResult, arrList
    Dim k, i, j

非常感谢老师,辛苦了.
这是工程师级别的高手 .
4楼
查看详细资料  楼主| 发表于 2021-3-25 19:30 | 只看该作者
shuidisyy 发表于 2021-3-24 16:12
Sub test()
    Dim arrData, arrResult, arrList
    Dim k, i, j

大师啊.能不能再帮我看看最后一个代码.提取的

http://www.codeforacause.net/forum.php ... d=462239&extra=

辛苦您了.
5楼
 楼主| 发表于 2021-3-29 17:27 | 只看该作者
shuidisyy 发表于 2021-3-24 16:12
Sub test()
    Dim arrData, arrResult, arrList
    Dim k, i, j

尊敬的大师,再帮我看看最后一个吧.
您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|manbet ( )

GMT+8, 2021-4-1 00:26 , Processed in 0.109200 second(s), 5 queries , Gzip On, Redis On.

Powered by X3.4

Copyright © 2001-2020, Tencent Cloud.

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