求助优化代码

lofty0623

循环的时候，工作表较多，大概有上百个，循环的时间太长了，求大神能优化下代码，本人MAC运行，好像用不了词典~

1. Sub Resettled()
   
2. Dim SH As Worksheet
   
3. Dim i, R, arr, s1, s2, s3
   
4. Application.ScreenUpdating = False
   
5. For Each SH In Worksheets
   
6.     With SH
   
7.         If .Name <> "汇总表" And .Name <> "模板" Then
   
8.             .Range("AJ18:AS18").ClearContents
   
9.             s1 = .Range("AJ18")
   
10.             s2 = .Range("AN18")
    
11.             s3 = .Range("AQ18")
    
12.              arr = .Range("AJ6").CurrentRegion
    
13.              For i = 5 To UBound(arr)
    
14.                     If arr(i, 6) = "正常安置" Then
    
15.                         s1 = s1 & arr(i, 1) & ":" & arr(i, 2) & ","
    
16.                     ElseIf arr(i, 6) = "照顾安置" Then
    
17.                         s2 = s2 & arr(i, 7) & ","
    
18.                     ElseIf arr(i, 6) = "优惠购买" Then
    
19.                         s3 = s3 & arr(i, 7) & ","
    
20.                     End If
    
21.              Next i
    
22.              .Range("AJ18") = s1
    
23.              .Range("AN18") = s2
    
24.              .Range("AQ18") = s3
    
25.        End If
    
26.     End With
    
27.   Next
    
28.   Application.ScreenUpdating = True
    
29. End Sub

复制代码

liulang0808

楼主看下是否有公式，先设置手动，在代码结束前设置自动。
建议供参考。。。。