[已解决]求助/VB根据A列查找

byeyes

                                           求助/VB根据A列查找




                                     求助查找.rar (9.04 KB, 下载次数: 31)

2012-8-27 01:12 上传

点击文件名下载附件       

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2012-8-27 01:41

1. Sub s1()
   
2.     Dim lastr&
   
3.     Dim c&
   
4.     Dim r&
   
5.     Dim i
   
6.    
   
7.     lastr = Range("a65535").End(xlUp).Row
   
8.     For i = 7 To lastr
   
9.         With Sheets("价格表")
   
10.             c = Application.WorksheetFunction.CountIf(.[a:a], Cells(i, 1).Value)
    
11.             If c > 0 Then
    
12.                 r = .[a:a].Find(Cells(i, 1), , , , , xlNext).Row
    
13.                 Cells(i, 1).Resize(1, 9).Value = .Cells(r, 1).Resize(1, 9).Value
    
14.             End If
    
15.         End With
    
16.     Next
    
17. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Sub s1()
   
2.     Dim lastr&
   
3.     Dim c&
   
4.     Dim r&
   
5.     Dim i
   
6.    
   
7.     lastr = Range("a65535").End(xlUp).Row
   
8.     For i = 7 To lastr
   
9.         With Sheets("价格表")
   
10.             c = Application.WorksheetFunction.CountIf(.[a:a], Cells(i, 1).Value)
    
11.             If c > 0 Then
    
12.                 r = .[a:a].Find(Cells(i, 1), , , , , xlNext).Row
    
13.                 Cells(i, 1).Resize(1, 9).Value = .Cells(r, 1).Resize(1, 9).Value
    
14.             End If
    
15.         End With
    
16.     Next
    
17. End Sub

复制代码

byeyes

hwc2ycy 发表于 2012-8-27 01:41

                       

                                                                   谢谢    hwc2ycy

hwc2ycy

刚测试发现FIND参数用误。

1. Sub s1()
   
2.     Dim lastr&
   
3.     Dim c&
   
4.     Dim r&
   
5.     Dim i&
   
6.    
   
7.     Application.ScreenUpdating = False
   
8.    
   
9.     lastr = Range("a65535").End(xlUp).Row
   
10.     For i = 7 To lastr
    
11.         With Sheets("价格表")
    
12.             c = Application.WorksheetFunction.CountIf(.[a:a], Cells(i, 1).Value)
    
13.             If c > 0 Then
    
14.                 r = .[a:a].Find(Cells(i, 1), , , xlWhole, , xlNext).Row
    
15.                 Cells(i, 1).Resize(1, 9).Value = .Cells(r, 1).Resize(1, 9).Value
    
16.             End If
    
17.         End With
    
18.     Next
    
19. End Sub
    

复制代码

hwc2ycy

byeyes 发表于 2012-8-27 01:48
谢谢 ...

用我刚发的新的，上面的有点小暇渍。