[已解决]求助：数据批量处理

斜阳几度

感激论坛高手的无私帮助！！斜阳几度再次深深谢过！！！
  以下说明，另见附件！

说明：
    所有数据都是0到9的个位数。A列数据10万个，B列数据6个。
    判断B1:B6单元格(6个单元格)是否与A1:A6单元格（6个单元格）值完全相等，如不等，则判断B1:B6是否与A2:A7单元格数据完全相等，依次判断（相当于函数里面的下拉），如B1:B6单元格与A1:A6单元格相等，则将A7单元格返回到E1中（第二条信息返回E2…依次排列），同时将A17的行数值返回到D1（第二条信息返回到D2…依次排列），同时将循环的次数返回到C1（因为要进行几次循环，所以要分清楚是第几次循环采集到的数据）。这样一条信息采集完成，逐行比对，依次采集所有信息。
    完成后，再判断B2:B6单元格(5个单元格)是否与A1:A5单元格（5个单元格）值完全相等，如不等，则判断B2:B6是否与A2:A6单元格数据完全相等，依次判断，如B2:B6单元格与A1:A5单元格相等，则将A6单元格值返回到E列中，同时将A6的行数值返回到D列，同时将循环的次数返回到C列。如有与已采集数据行数重复，则不再采集，这样依次采集所有信息。
    完成后，再判断B3:B6单元格(4个单元格)是否与A1:A4单元格（4个单元格）值完全相等，如不等，则判断B3:B6是否与A2:A5单元格数据完全相等，依次判断，如B3:B6单元格与A1:A4单元格相等，则将A5单元格返回到E列中，同时将A5的行数值返回到D列，同时将循环的次数返回到C列。如有与已采集数据行数重复，则不再采集，这样依次采集所有信息。
    以上三次循环，采集后退出程序！

本表版本为 excel 2013 由于数据关系，无法使用2003版。

                        斜阳几度在此谢过！！！

最佳答案

月排行榜 / 总排行榜

yorkchenshunan

2017-6-19 14:42

1. Sub shujuchuli()
   
2. Dim n As Long, m As Long, arr, brr, i%, j%, k%, r%, crr(1 To 100000, 1 To 3), s As Boolean
   
3. Columns("c:e").ClearContents
   
4. arr = Range("a1:a100000")
   
5. brr = Range("b1:b6")
   
6.         m = 1
   
7. For i = 1 To 3
   
8.     For n = 1 To 100000 - 6 + i - 1
   
9.         r = 0
   
10.         For j = i To 6
    
11.                 If brr(j, 1) <> arr(j + n - i, 1) Then Exit For
    
12.                 r = r + 1
    
13.         Next
    
14.         If r = 6 - i + 1 Then
    
15.             If m > 1 Then
    
16.                 For k = 1 To m
    
17.                     If crr(k, 2) = 7 + n - i Then
    
18.                         s = True
    
19.                         Exit For
    
20.                     End If
    
21.                 Next
    
22.                 If Not s Then
    
23.                     crr(m, 1) = i
    
24.                     crr(m, 2) = 7 + n - i
    
25.                     crr(m, 3) = arr(7 + n - i, 1)
    
26.                     m = m + 1
    
27.                 End If
    
28.                 s = False
    
29.             Else
    
30.                 crr(m, 1) = i
    
31.                 crr(m, 2) = 7 + n - i
    
32.                 crr(m, 3) = arr(7 + n - i, 1)
    
33.                 m = m + 1
    
34.             End If
    
35.         End If
    
36.     Next
    
37. Next
    
38. Range("c1").Resize(m, 3) = crr
    
39. End Sub
    

复制代码

跳转到最佳答案楼层

yorkchenshunan

1. Sub shujuchuli()
   
2. Dim n As Long, m As Long, arr, brr, i%, j%, k%, r%, crr(1 To 100000, 1 To 3), s As Boolean
   
3. Columns("c:e").ClearContents
   
4. arr = Range("a1:a100000")
   
5. brr = Range("b1:b6")
   
6.         m = 1
   
7. For i = 1 To 3
   
8.     For n = 1 To 100000 - 6 + i - 1
   
9.         r = 0
   
10.         For j = i To 6
    
11.                 If brr(j, 1) <> arr(j + n - i, 1) Then Exit For
    
12.                 r = r + 1
    
13.         Next
    
14.         If r = 6 - i + 1 Then
    
15.             If m > 1 Then
    
16.                 For k = 1 To m
    
17.                     If crr(k, 2) = 7 + n - i Then
    
18.                         s = True
    
19.                         Exit For
    
20.                     End If
    
21.                 Next
    
22.                 If Not s Then
    
23.                     crr(m, 1) = i
    
24.                     crr(m, 2) = 7 + n - i
    
25.                     crr(m, 3) = arr(7 + n - i, 1)
    
26.                     m = m + 1
    
27.                 End If
    
28.                 s = False
    
29.             Else
    
30.                 crr(m, 1) = i
    
31.                 crr(m, 2) = 7 + n - i
    
32.                 crr(m, 3) = arr(7 + n - i, 1)
    
33.                 m = m + 1
    
34.             End If
    
35.         End If
    
36.     Next
    
37. Next
    
38. Range("c1").Resize(m, 3) = crr
    
39. End Sub
    

复制代码

斜阳几度

yorkchenshunan 发表于 2017-6-19 14:42

     依旧是那么好！无瑕疵！！正是我要的结果！感谢你！！真的，太谢谢了！这么大的数据量，瞬间就能解决！呵呵！从前的我都不敢想啊 ！

             斜阳几度再次深表感谢！！！！