[已解决]过程太大运行不了，求高手帮简化

liuab11

    初学者，写的一段VBA程序运行时显示“vba过程太大”，求高手简化！！！

最佳答案

月排行榜 / 总排行榜

grf1973

2015-10-23 10:17

你的程序简直是令人无法忍受，不换思路，没有改进的可能。。。。干脆重写一个了。

跳转到最佳答案楼层

这儿有肥猫

应该用数透就可以了~没必要用VBA~

liuab11

这儿有肥猫 发表于 2015-10-22 15:40
应该用数透就可以了~没必要用VBA~

数透解决不了区间统计问题，数透后还是要手工汇总呀。

liuab11

刚减了三分之二程序后，发现还有好多问题，运行不下去，难道case语句判断不了文本？求高手帮修改一个能运行的简化程序！！！！拜托！！！

这儿有肥猫

马上下班，个人建议是数组解决~应该不是太难

liuab11

求高手解决！！

上清宫主

过程太大，可以分拆成几段，然后再调用
就你的代码来说，可以来减肥，如
For Each vartemp In Range("c3:k61") '清空单元格ElseIf
         vartemp.Value = ""
      Next vartemp
就可以减成一行Range("c3:k61")=""

其余地方估计还有，没细看。


其实不防把你的问题描述一下，让达人们给你另写段代码，应该要好很多

grf1973

1. Sub tt()
   
2.     Dim gznx(100)     '工作年限分段
   
3.     Dim rznx(100)     '任职年限分段
   
4.     For i = 0 To 100
   
5.         If i <= 15 Then
   
6.             gznx(i) = IIf(i <= 5, "5以下", IIf(i <= 10, "6-10", "11-15"))
   
7.             rznx(i) = IIf(i <= 5, "5以下", IIf(i <= 10, "6-10", "11-15"))
   
8.         Else
   
9.             rznx(i) = "16以上"
   
10.             gznx(i) = IIf(i <= 20, "16-20", IIf(i <= 25, "21-25", IIf(i <= 30, "26-30", IIf(i <= 35, "31-35", IIf(i <= 40, "36-40", "41以上")))))
    
11.         End If
    
12.     Next
    
13.    
    
14.     arr = Sheets("Sheet1").Range("b3:t" & Sheets("Sheet1").[b65536].End(3).Row)  '源数据
    
15.     Set d = CreateObject("scripting.dictionary")
    
16.     For i = 3 To UBound(arr)
    
17.         gw = arr(i, 17)  '职务岗位
    
18.         nx1 = rznx(arr(i, 19))  '任职年限
    
19.         nx2 = gznx(arr(i, 13))  '工作年限
    
20.         x = gw & nx1 & nx2      '职务岗位+任职年限+工作年限为key
    
21.         d(x) = d(x) + 1
    
22.     Next
    
23.    
    
24.     With Sheets("表1")    '汇总结果
    
25.         arr = .[a1].CurrentRegion
    
26.         brr = arr
    
27.         For i = 3 To UBound(arr)
    
28.             If arr(i, 1) = "" Then arr(i, 1) = arr(i - 1, 1)       '工作岗位，如果为空则取上行工作岗位
    
29.             gw = arr(i, 1): nx1 = arr(i, 2)
    
30.             For j = 3 To UBound(arr, 2)
    
31.                 nx2 = arr(2, j)
    
32.                 x = gw & nx1 & nx2     '职务岗位+任职年限+工作年限为key
    
33.                 If d(x) > 0 Then
    
34.                     brr(i, j) = d(x)
    
35.                     brr(UBound(brr), j) = brr(UBound(brr), j) + d(x)       '总计
    
36.                 End If
    
37.             Next
    
38.         Next
    
39.         .[a1].CurrentRegion = brr
    
40.     End With
    
41. End Sub

复制代码

grf1973

你的程序简直是令人无法忍受，不换思路，没有改进的可能。。。。干脆重写一个了。

liuab11

不好意思，初学者，谢谢楼上高手！！