[已解决]简化代码

ww0000

附件中的代码：在C5输入条件，运行代码即可从表1提取相应姓名到表2，但用了IF好象很慢，能不能改进一下，提高速度

培训测试表2.rar (24.04 KB, 下载次数: 7)

2017-3-10 17:33 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

ilovelittle

2017-3-10 18:16

1. Sub 提取指定内容()
   
2.     Dim arr(1 To 20, 1 To 8)
   
3.     Dim brr, k, k1, i
   
4.     On Error Resume Next
   
5.     brr = Sheets("名单").Range("a2:b286")
   
6.     scvalue = Sheets("签到表").Range("c5")
   
7.     k = 0: k1 = 1
   
8.     For i = 1 To UBound(brr)
   
9.         If brr(i, 2) = scvalue Then
   
10.             k = k + 1
    
11.             arr(k, k1) = brr(i, 1)
    
12.         End If
    
13.         If k = 20 Then k = 0: k1 = k1 + 2
    
14.     Next
    
15.     Range("a7").Resize(20, k1) = arr
    
16. End Sub

复制代码

跳转到最佳答案楼层

ilovelittle

1. Sub 提取指定内容()
   
2.     Dim arr(1 To 20, 1 To 8)
   
3.     Dim brr, k, k1, i
   
4.     On Error Resume Next
   
5.     brr = Sheets("名单").Range("a2:b286")
   
6.     scvalue = Sheets("签到表").Range("c5")
   
7.     k = 0: k1 = 1
   
8.     For i = 1 To UBound(brr)
   
9.         If brr(i, 2) = scvalue Then
   
10.             k = k + 1
    
11.             arr(k, k1) = brr(i, 1)
    
12.         End If
    
13.         If k = 20 Then k = 0: k1 = k1 + 2
    
14.     Next
    
15.     Range("a7").Resize(20, k1) = arr
    
16. End Sub

复制代码

ww0000

ilovelittle 发表于 2017-3-10 18:16

Dim arr(1 To 20, 1 To 8)
改成Dim arr(1 To 20, 1 To 16)
其他很好，谢谢！

ww0000

ilovelittle 发表于 2017-3-10 18:16

能否后面解释一下？

ilovelittle

那你后面if k = 20 也改一下。

ww0000

行到20行没错，列要到16列，所以要改

ilovelittle

如果答案对你有帮助，评个最佳呗