[已解决]如何进行数据对比提取

sure

各位专家，小弟有一个数据对比然后提取的excel数据表要处理，具体如下：sheet1工作表里是全部需要处理的数据，sheet2是关键字1，sheet3是关键字2，然后是这样进行提取，
1、首先确定sheet2的关键字，譬如J00，
2、然后在sheet3的关键字里面提取，比如先提取B01，随后在sheet1里面查找是否有B列为J00，C列为B01的行，有的话将那行值填入report里面，没有的话在report里面填出对应的J00和B01值，后面的行值用NC代替，直到将sheet3里的关键字全部查找完成；
3、然后在sheet2里面查找J01；
4、重复步骤2，直到关键字全部查找完成；
5、重复以上步骤，直到将 sheet2里的关键字全部查找完成；
6、将数据全部填入report。

最佳答案

月排行榜 / 总排行榜

dsmch

2014-8-3 14:04

………………

跳转到最佳答案楼层

su45

你试下吧：

数组填充.zip (73.51 KB, 下载次数: 11)

2014-8-3 12:10 上传

点击文件名下载附件

dsmch

………………

su45

dsmch 发表于 2014-8-3 14:04
………………

没想到用字典会快这么多！

sure

再请教下各位老师，根据3楼的字典法，可以将sheet2和sheet3里面的关键字在sheet1的数据里面查找出相同的项填充到report里面，但是如果sheet2和sheet3里面的关键字在sheet1的数据里面查找不到相同的项，我希望也将这部分在report里面列出来，譬如在附件“模拟输出”里面的M06，在sheet1里面查找不到，但是在report里面我也要将其列出来，后面填充NC，这样的话应该如何根据字典法将3楼的程序补充完整？谢谢各位大大了

grf1973

在3楼

1. Sub Macro1()
   
2.     Dim arr, brr, crr, drr, d, i&, j&, k&, zf$$
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheet1.Range("a1").CurrentRegion
   
5.     brr = Sheet2.Range("a1").CurrentRegion
   
6.     crr = Sheet3.Range("a1").CurrentRegion
   
7.     ReDim drr(1 To UBound(arr), 1 To UBound(arr, 2))
   
8.     For i = 4 To UBound(arr)
   
9.         zf = arr(i, 2) & "," & arr(i, 3)
   
10.         d(zf) = i
    
11.     Next
    
12.     For i = 1 To UBound(brr)
    
13.         For j = 1 To UBound(crr)
    
14.             zf = brr(i, 1) & "," & crr(j, 1)
    
15.             s = s + 1
    
16.             If d.exists(zf) Then
    
17.                 n = d(zf)
    
18.                 For k = 1 To UBound(arr, 2)
    
19.                     drr(s, k) = arr(n, k)
    
20.                 Next
    
21.             Else
    
22.                 For k = 1 To UBound(arr, 2)
    
23.                     drr(s, k) = "NC"
    
24.                 Next
    
25.                 drr(s, 2) = brr(i, 1): drr(s, 3) = crr(j, 1)
    
26.             End If
    
27.         Next
    
28.     Next
    
29.     Sheet4.Activate
    
30.     ActiveSheet.UsedRange.Clear
    
31.     Sheet1.[a1].Resize(2, UBound(arr, 2)).Copy [a1]
    
32.     [a3].Resize(s, UBound(drr, 2)) = drr
    
33. End Sub

复制代码

的代码上改了一下。

sure

grf1973 发表于 2014-8-4 14:07
在3楼的代码上改了一下。

谢谢，我最后也改出来了，但是代码比你的复杂了点。
Else
           s = s + 1
           drr(s, 1) = arr(3, 1)
           drr(s, 2) = brr(i, 1)
           drr(s, 3) = crr(j, 1)
         For k = 4 To UBound(arr, 2)
           drr(s, k) = "NA"
         Next
        End If