[已解决]求加个循环

oplkj

想1到10个表都运行一遍,每表的结果从每表的L3开始放
sub DD4()
    On Error Resume Next
    Dim ar(0 To 999), arr, re(1 To 9999, 1 To 1) As String
    Dim i As Integer, j As Integer, k As Integer, x As Integer, Cnt As Integer
    arr = Range("N3:DE5500")
    For i = 1 To UBound(arr, 2)
        For k = 1 To UBound(arr)
            If arr(k, i) <> "" Then ar(Val(arr(k, i))) = ar(Val(arr(k, i))) + 1
        Next k
        For j = 0 To UBound(ar)
            If ar(j) = "" Then
                Cnt = Cnt + 1
                re(Cnt, 1) = Format(j, "000")
            End If
        Next j
        Erase ar
    Next i
    Range("L3").Resize(UBound(re)) = re
End sub

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2014-3-20 15:47

oplkj 发表于 2014-3-20 15:41
表2的结果并不是从L3开始放

1. Sub Mac1()
   
2. 
   
3.     On Error Resume Next
   
4.     Dim ar(0 To 999), arr, re(1 To 9999, 1 To 1) As String
   
5.     Dim i As Integer, j As Integer, k As Integer, x As Integer, Cnt As Integer
   
6.     For i = 1 To 2
   
7.         With Worksheets(i)
   
8.             arr = .Range("N3:Q5500")
   
9.             For x = 1 To UBound(arr, 2)
   
10.                 For k = 1 To UBound(arr)
    
11.                     If arr(k, x) <> "" Then ar(Val(arr(k, x))) = ar(Val(arr(k, x))) + 1
    
12.                 Next k
    
13.                 For j = 0 To UBound(ar)
    
14.                     If ar(j) = "" Then
    
15.                         Cnt = Cnt + 1
    
16.                         re(Cnt, 1) = Format(j, "000")
    
17.                     End If
    
18.                 Next j
    
19.                 Erase ar
    
20.             Next x
    
21.             .Range("L3").Resize(UBound(re)) = re
    
22.             Erase re
    
23.             Cnt = 0
    
24.         End With
    
25.     Next
    
26. End Sub

复制代码

我是觉着输出怪怪的，怎么多了空格，又忘了复位cnt了。

跳转到最佳答案楼层

hwc2ycy

1. On Error Resume Next
   
2. Dim ar(0 To 999), arr, re(1 To 9999, 1 To 1) As String
   
3. Dim i As Integer, j As Integer, k As Integer, x As Integer, Cnt As Integer
   
4. For i = 1 To 10
   
5.     With Worksheets(i)
   
6.         arr = .Range("N3:DE5500")
   
7.         For i = 1 To UBound(arr, 2)
   
8.             For k = 1 To UBound(arr)
   
9.                 If arr(k, i) <> "" Then ar(Val(arr(k, i))) = ar(Val(arr(k, i))) + 1
   
10.             Next k
    
11.             For j = 0 To UBound(ar)
    
12.                 If ar(j) = "" Then
    
13.                     Cnt = Cnt + 1
    
14.                     re(Cnt, 1) = Format(j, "000")
    
15.                 End If
    
16.             Next j
    
17.             Erase ar
    
18.         Next i
    
19.         .Range("L3").Resize(UBound(re)) = re
    
20.     End With
    
21. Next

复制代码

oplkj

hwc2ycy 发表于 2014-3-20 14:22

有点问题,表1的结果也会放到表2的结果里去,后面没看,

hwc2ycy

oplkj 发表于 2014-3-20 14:48
有点问题,表1的结果也会放到表2的结果里去,后面没看,

你原来的代码表1的结果也放到表2了，只是加了个工作表限制符，没理由。
你上传测试的数据吧。

oplkj

hwc2ycy 发表于 2014-3-20 14:59
你原来的代码表1的结果也放到表2了，只是加了个工作表限制符，没理由。
你上传测试的数据吧。

Book1.rar (132.01 KB, 下载次数: 4)

2014-3-20 15:14 上传

点击文件名下载附件

hwc2ycy

1.     On Error Resume Next
   
2.     Dim ar(0 To 999), arr, re(1 To 9999, 1 To 1) As String
   
3.     Dim i As Integer, j As Integer, k As Integer, x As Integer, Cnt As Integer
   
4.     For i = 1 To 2
   
5.         With Worksheets(i)
   
6.             arr = .Range("N3:Q5500")
   
7.             For x = 1 To UBound(arr, 2)
   
8.                 For k = 1 To UBound(arr)
   
9.                     If arr(k, x) <> "" Then ar(Val(arr(k, x))) = ar(Val(arr(k, x))) + 1
   
10.                 Next k
    
11.                 For j = 0 To UBound(ar)
    
12.                     If ar(j) = "" Then
    
13.                         Cnt = Cnt + 1
    
14.                         re(Cnt, 1) = Format(j, "000")
    
15.                     End If
    
16.                 Next j
    
17.                 Erase ar
    
18.             Next x
    
19.             .Range("L3").Resize(UBound(re)) = re
    
20.             Erase re
    
21.         End With
    
22.     Next

复制代码

re数组忘了清除了。

oplkj

hwc2ycy 发表于 2014-3-20 15:30
re数组忘了清除了。

表2的结果并不是从L3开始放

hwc2ycy

oplkj 发表于 2014-3-20 15:41
表2的结果并不是从L3开始放

1. Sub Mac1()
   
2. 
   
3.     On Error Resume Next
   
4.     Dim ar(0 To 999), arr, re(1 To 9999, 1 To 1) As String
   
5.     Dim i As Integer, j As Integer, k As Integer, x As Integer, Cnt As Integer
   
6.     For i = 1 To 2
   
7.         With Worksheets(i)
   
8.             arr = .Range("N3:Q5500")
   
9.             For x = 1 To UBound(arr, 2)
   
10.                 For k = 1 To UBound(arr)
    
11.                     If arr(k, x) <> "" Then ar(Val(arr(k, x))) = ar(Val(arr(k, x))) + 1
    
12.                 Next k
    
13.                 For j = 0 To UBound(ar)
    
14.                     If ar(j) = "" Then
    
15.                         Cnt = Cnt + 1
    
16.                         re(Cnt, 1) = Format(j, "000")
    
17.                     End If
    
18.                 Next j
    
19.                 Erase ar
    
20.             Next x
    
21.             .Range("L3").Resize(UBound(re)) = re
    
22.             Erase re
    
23.             Cnt = 0
    
24.         End With
    
25.     Next
    
26. End Sub

复制代码

我是觉着输出怪怪的，怎么多了空格，又忘了复位cnt了。