[已解决]求助各位老师帮助内存数组计算编写

xuesheng1

    各位老师您们好，我是新手刚学VBA，看视频后感想颇多，想到我有大量数据要处理特求助老师们给与帮助，万分感谢！
    由于数据量很大，我仅是截取一部分，请帮助用内存数组处理，依次提取附带的“ku”工作薄的每个工作表数据至a:l 列（或者直接提至内存更好）
if(A2:H2>=N2:U2,if(I2=5,5,4),0) (对应单元全部大于，这个公式不对仅为描述方便)
if(A3:H3>=N2:U2,if(I3=5,5,4),0)
if(A4:H4>=N2:U2,if(I4=5,5,4),0)
循环至结尾，统计5和4的个数（这步统计后也可放入单元格），之后
if(A2:H2>=N3:U3,if(I2=5,5,4),0)
if(A3:H3>=N3:U3,if(I3=5,5,4),0)
结果放入 w x 列      万分感谢！！！

最佳答案

月排行榜 / 总排行榜

蓝桥玄霜

2015-4-17 11:32

1. Sub lqxs()
   
2.     Dim myPath$, myName$, Arr1, Sh As Worksheet
   
3.     Dim i&, Brr, Myr&, m5&, m4&, y&, j&, Arr, Crr
   
4.     Application.ScreenUpdating = False
   
5.     Sheet1.Activate
   
6.     [w:x].ClearContents
   
7.     myPath = ThisWorkbook.Path & ""
   
8.     myName = "ku.xls"
   
9.     With GetObject(myPath & myName)
   
10.         For Each Sh In .Sheets
    
11.             Arr1 = Sh.Range("A1").CurrentRegion
    
12.             Myr = Cells(Rows.Count, 1).End(xlUp).Row + 1
    
13.             Cells(Myr, 1).Resize(UBound(Arr1), UBound(Arr1, 2)) = Arr1
    
14.         Next
    
15.         .Close False
    
16.     End With
    
17.     Arr = [a1].CurrentRegion
    
18.     Brr = [n1].CurrentRegion
    
19.     ReDim Crr(1 To UBound(Brr), 1 To 2)
    
20.     For i = 2 To UBound(Brr)
    
21.         m5 = 0: m4 = 0
    
22.         For j = 1 To UBound(Arr)
    
23.             For y = 1 To 8
    
24.                 If Arr(j, y) < Brr(i, y) Then GoTo 100
    
25.             Next
    
26.             If Arr(j, 9) = 5 Then m5 = m5 + 1 Else m4 = m4 + 1
    
27. 100:
    
28.         Next
    
29.         Crr(i, 1) = m5: Crr(i, 2) = m4
    
30.     Next
    
31.     [w1].Resize(UBound(Crr), 2) = Crr
    
32.     Application.ScreenUpdating = True
    
33. End Sub
    
34. 
    

复制代码

跳转到最佳答案楼层

蓝桥玄霜

1. Sub lqxs()
   
2.     Dim myPath$, myName$, Arr1, Sh As Worksheet
   
3.     Dim i&, Brr, Myr&, m5&, m4&, y&, j&, Arr, Crr
   
4.     Application.ScreenUpdating = False
   
5.     Sheet1.Activate
   
6.     [w:x].ClearContents
   
7.     myPath = ThisWorkbook.Path & ""
   
8.     myName = "ku.xls"
   
9.     With GetObject(myPath & myName)
   
10.         For Each Sh In .Sheets
    
11.             Arr1 = Sh.Range("A1").CurrentRegion
    
12.             Myr = Cells(Rows.Count, 1).End(xlUp).Row + 1
    
13.             Cells(Myr, 1).Resize(UBound(Arr1), UBound(Arr1, 2)) = Arr1
    
14.         Next
    
15.         .Close False
    
16.     End With
    
17.     Arr = [a1].CurrentRegion
    
18.     Brr = [n1].CurrentRegion
    
19.     ReDim Crr(1 To UBound(Brr), 1 To 2)
    
20.     For i = 2 To UBound(Brr)
    
21.         m5 = 0: m4 = 0
    
22.         For j = 1 To UBound(Arr)
    
23.             For y = 1 To 8
    
24.                 If Arr(j, y) < Brr(i, y) Then GoTo 100
    
25.             Next
    
26.             If Arr(j, 9) = 5 Then m5 = m5 + 1 Else m4 = m4 + 1
    
27. 100:
    
28.         Next
    
29.         Crr(i, 1) = m5: Crr(i, 2) = m4
    
30.     Next
    
31.     [w1].Resize(UBound(Crr), 2) = Crr
    
32.     Application.ScreenUpdating = True
    
33. End Sub
    
34. 
    

复制代码

xuesheng1

蓝桥玄霜 发表于 2015-4-17 11:32

谢谢 蓝桥玄霜 老师，我一定好好学习，深刻理解您的绝佳思路
祝您工作顺心！万事如意！！