[已解决]请老师指教i = 1 To Range("a16").End(xlUp).Row的用法

ymq123

请老师指教i = 1 To Range("a16").End(xlUp).Row的用法，具体看代码。谢谢！

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-3-25 13:44

原来的代码没有考虑到全是空行的情况。

1. Sub 表格提取相同行()
   
2. 
   
3.     Dim arr1, arr2
   
4.     arr1 = Range("A1:G15")
   
5.     arr2 = Range("a17:g31")
   
6.     Dim key1 As String
   
7. 
   
8.     Dim result()
   
9.     ReDim result(1 To UBound(arr1), 1 To UBound(arr1, 2))
   
10. 
    
11.     Dim i As Byte, j As Byte, k As Byte, l As Byte, m As Byte
    
12.     Dim blCancel As Boolean
    
13. 
    
14.     '外层ARR1
    
15.     For i = LBound(arr1) To UBound(arr1)
    
16.         '内层ARR2
    
17.         For j = LBound(arr1) To UBound(arr1)
    
18.             blCancel = False
    
19.             '列对比
    
20.             key1 = ""
    
21.             For k = LBound(arr1, 2) To UBound(arr1, 2)
    
22.                 key1 = key1 & arr1(i, k)
    
23.                 If arr1(i, k) <> arr2(j, k) Then
    
24.                     blCancel = True
    
25.                     Exit For
    
26.                 End If
    
27.             Next
    
28.             If Not blCancel And Len(key1) > 0 Then
    
29.                 Debug.Print "arr1(" & i & "--arr2(" & j
    
30.                 l = l + 1
    
31.                 For m = LBound(arr1, 2) To UBound(arr1, 2)
    
32.                     result(l, m) = arr1(i, m)
    
33.                 Next
    
34.             End If
    
35.         Next
    
36.     Next
    
37. 
    
38.     If l > 0 Then
    
39.         Range("u2").Resize(l, UBound(arr1, 2)) = result
    
40.     Else
    
41.         MsgBox "无相同的数据行"
    
42.     End If
    
43. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

zjdh

Sub t()
    Dim arr1, arr2, arr3(1 To 11, 1 To 7), i!, j!, k!,m!, n!
    arr1 = Range("A1").CurrentRegion
    arr2 = Range("A17").CurrentRegion
    For i = 1 To UBound(arr1)
        For j = 1 To UBound(arr2)
            For k = 1 To 7
                If arr1(i, k) <> arr2(j, k) Then Exit For
                If k = 7 Then
                    n = n + 1
                    For m = 1 To 7
                        arr3(n, m) = arr1(i, m)
                    Next
                End If
            Next
        Next
    Next
    Range("U2:AA12") = arr3
End Sub

hwc2ycy

1. Sub 提取相同行()
   
2.     Dim arr1, arr2
   
3.     arr1 = Range("A1:G15")
   
4.     arr2 = Range("a17:g31")
   
5.     Dim result()
   
6.     ReDim result(1 To UBound(arr1), 1 To UBound(arr1, 2))
   
7.     Dim i As Byte, j As Byte, blCancel As Boolean, k As Byte, l As Byte
   
8.     For k = LBound(arr2) To UBound(arr2)
   
9.         For i = LBound(arr1) To UBound(arr1)
   
10.             For j = LBound(arr1, 2) To UBound(arr1, 2)
    
11.                 Debug.Print arr1(i, j) & " vs " & arr2(k, j)
    
12.                 If arr1(i, j) <> arr2(k, j) Then
    
13.                     blCancel = True
    
14.                     Exit For
    
15.                 End If
    
16.             Next
    
17.             If Not blCancel Then
    
18.                 l = l + 1
    
19.                 For j = LBound(arr1, 2) To UBound(arr1, 2)
    
20.                     result(l, j) = arr1(i, j)
    
21.                 Next
    
22.                 blCancel = False
    
23.             End If
    
24.         Next
    
25.     Next
    
26.     If l > 0 Then
    
27.         Range("u2").Resize(l, UBound(arr1, 2)) = result
    
28.     Else
    
29.         MsgBox "无相同的数据行"
    
30.     End If
    
31. End Sub
    

复制代码

hwc2ycy

用了多层循环，其实用字典来实现更快。上次帮人写了个的。

hwc2ycy

1. Sub 字典法()
   
2.    
   
3.     Dim arr1, arr2
   
4.     arr1 = Range("A1:G15")
   
5.     arr2 = Range("a17:g31")
   
6.     Dim result()
   
7.     ReDim result(1 To UBound(arr1), 1 To UBound(arr1, 2))
   
8.    
   
9.     Dim key1 As String, key2 As String
   
10.    
    
11.     Dim dic1 As Object, dic2 As Object
    
12.     Set dic1 = CreateObject("scripting.dictionary")
    
13.     Set dic2 = CreateObject("scripting.dictionary")
    
14.    
    
15.     Dim i As Byte, j As Byte
    
16.     For i = LBound(arr1) To UBound(arr1)
    
17.         For j = LBound(arr1, 2) To UBound(arr1, 2)
    
18.             key1 = key1 & arr1(i, j) & ","
    
19.             key2 = key2 & arr2(i, j) & ","
    
20.         Next
    
21.         dic1(Left(key1, Len(key1) - 1)) = ""
    
22.         dic2(Left(key2, Len(key2) - 1)) = ""
    
23.         key1 = ""
    
24.         key2 = ""
    
25.     Next
    
26.     Dim a, l As Byte
    
27.     Dim arrTemp
    
28.     For Each a In dic1.keys
    
29.         If dic2.exists(a) Then
    
30.             arrTemp = Split(a, ",")
    
31.             l = l + 1
    
32.             For i = LBound(arrTemp) To UBound(arrTemp)
    
33.                 result(l, i + 1) = arrTemp(i)
    
34.             Next
    
35.         End If
    
36.     Next
    
37.     If l > 0 Then
    
38.         Range("u2").Resize(l, UBound(arr1, 2)) = result
    
39.     Else
    
40.         MsgBox "无相同的数据行"
    
41.     End If
    
42. End Sub
    

复制代码

冒似上面的循环代码结果不对了。

hwc2ycy

原来的代码没有考虑到全是空行的情况。

1. Sub 表格提取相同行()
   
2. 
   
3.     Dim arr1, arr2
   
4.     arr1 = Range("A1:G15")
   
5.     arr2 = Range("a17:g31")
   
6.     Dim key1 As String
   
7. 
   
8.     Dim result()
   
9.     ReDim result(1 To UBound(arr1), 1 To UBound(arr1, 2))
   
10. 
    
11.     Dim i As Byte, j As Byte, k As Byte, l As Byte, m As Byte
    
12.     Dim blCancel As Boolean
    
13. 
    
14.     '外层ARR1
    
15.     For i = LBound(arr1) To UBound(arr1)
    
16.         '内层ARR2
    
17.         For j = LBound(arr1) To UBound(arr1)
    
18.             blCancel = False
    
19.             '列对比
    
20.             key1 = ""
    
21.             For k = LBound(arr1, 2) To UBound(arr1, 2)
    
22.                 key1 = key1 & arr1(i, k)
    
23.                 If arr1(i, k) <> arr2(j, k) Then
    
24.                     blCancel = True
    
25.                     Exit For
    
26.                 End If
    
27.             Next
    
28.             If Not blCancel And Len(key1) > 0 Then
    
29.                 Debug.Print "arr1(" & i & "--arr2(" & j
    
30.                 l = l + 1
    
31.                 For m = LBound(arr1, 2) To UBound(arr1, 2)
    
32.                     result(l, m) = arr1(i, m)
    
33.                 Next
    
34.             End If
    
35.         Next
    
36.     Next
    
37. 
    
38.     If l > 0 Then
    
39.         Range("u2").Resize(l, UBound(arr1, 2)) = result
    
40.     Else
    
41.         MsgBox "无相同的数据行"
    
42.     End If
    
43. End Sub

复制代码

hwc2ycy

字典法会去重复的相同行。