根据条件从数据表中提取相应数据填充到指定单元格

R918124

请各位老师帮忙看一下，如何从指定sheet根据条件调取数据并填充到指定单元格.谢谢

kkf5560

1. Option Explicit
   
2. 
   
3. Sub DailyReport()
   
4.     Dim Dic As Object, rDate, Res, i&, k&, n&, Rng As Range, Str$, Tx$
   
5.     Set Dic = CreateObject("Scripting.Dictionary")
   
6.     Set Rng = Sheet1.Range("a6", "l34")
   
7.     Sheet1.Range("a7", "l34").ClearContents
   
8.     Res = Rng
   
9.     Tx = Sheet1.Range("b2") & Sheet1.Range("e2")
   
10.     For i = 1 To UBound(Res, 2) '写入标题索引
    
11.         Str = Res(1, i)
    
12.         Dic(Str) = i
    
13.     Next i
    
14.     rDate = Sheet2.Range("a1").CurrentRegion
    
15.     n = 1
    
16.     For i = 1 To UBound(rDate) '
    
17.         Str = rDate(i, 1) & rDate(i, 2)
    
18.         If Str = Tx Then '查找条件
    
19.             n = n + 1
    
20.             For k = 1 To UBound(rDate, 2) '定位标题
    
21.                 If Dic.exists(rDate(1, k)) Then
    
22.                     Res(n, Dic(rDate(1, k))) = rDate(i, k) '写入
    
23.                 End If
    
24.             Next k
    
25.         End If
    
26.     Next i
    
27.     Rng = Res
    
28. End Sub

复制代码