[已解决]求助：表格工作表查找对比

xu641781400

要求两个工作表对比相同的，并且填写相应的日期！！

最佳答案

月排行榜 / 总排行榜

lzclzch

2012-8-21 20:17

Sub 查询()
Dim r%, arr, brr()
arr = Sheet2.Range("a2:a" & Sheet2.Range("a65536").End(3).Row)
ReDim brr(1 To UBound(arr), 1 To 1)
For r = 1 To UBound(arr)
m = m + 1
brr(m, 1) = Application.VLookup(arr(r, 1), Sheet1.Range("a2:b9"), 2, 0)
Next
Sheet2.Range("c2").Resize(m, 1) = brr
End Sub

跳转到最佳答案楼层

286779240

1. =VLOOKUP(A2,表一!A:B,2,)

复制代码

xu641781400

286779240 发表于 2012-8-21 20:08

需要用VBA代码！！！

hrpotter

1. Sub test()
   
2.     Dim arr, brr(), d
   
3.     Dim i As Long
   
4.     On Error Resume Next
   
5.     Set d = CreateObject("scripting.dictionary")
   
6.     arr = Sheets("表一").Range("a1").CurrentRegion
   
7.     For i = 2 To UBound(arr)
   
8.         d(arr(i, 1)) = arr(i, 2)
   
9.     Next
   
10.     With Sheets("表二")
    
11.         arr = .Range("a2:a" & .Range("a65536").End(xlUp).Row)
    
12.         ReDim brr(1 To UBound(arr), 1 To 1)
    
13.         For i = 1 To UBound(arr)
    
14.             brr(i, 1) = d(arr(i, 1))
    
15.         Next
    
16.         .Range("c2:c65536").ClearContents
    
17.         .Range("c2").Resize(UBound(brr), 1) = brr
    
18.     End With
    
19. End Sub

复制代码

那么的帅

查找对应数据(VBA).rar (8.31 KB, 下载次数: 7)

2012-8-21 20:16 上传

点击文件名下载附件

lzclzch

Sub 查询()
Dim r%, arr, brr()
arr = Sheet2.Range("a2:a" & Sheet2.Range("a65536").End(3).Row)
ReDim brr(1 To UBound(arr), 1 To 1)
For r = 1 To UBound(arr)
m = m + 1
brr(m, 1) = Application.VLookup(arr(r, 1), Sheet1.Range("a2:b9"), 2, 0)
Next
Sheet2.Range("c2").Resize(m, 1) = brr
End Sub

xu641781400

lzclzch 发表于 2012-8-21 20:17
Sub 查询()
Dim r%, arr, brr()
arr = Sheet2.Range("a2:a" & Sheet2.Range("a65536").End(3).Row)

新输入的数据会给删掉的！！求修改

lzclzch

你是不是在sheet2C列中输入数据呢
是不是想已录入的数据不要被替换掉吗

xu641781400

是的！！！！！！！其余单元格不动，只要求动对应编号的日期

xu641781400

lzclzch 发表于 2012-8-21 21:32
你是不是在sheet2C列中输入数据呢
是不是想已录入的数据不要被替换掉吗

是的！！！！！！！其余单元格不动，只要求动对应编号的日期