[已解决]查找数据

lgzxmlg

查找数据.zip (12.96 KB, 下载次数: 5)

2012-1-8 22:02 上传

点击文件名下载附件 根据条件查找两种情况的数据。

最佳答案

月排行榜 / 总排行榜

sunjing-zxl

2012-1-8 22:46

1. Sub czsj()
   
2.     Dim arr1, arr2, arr3, arr4
   
3.     Dim i As Long, j As Long, n As Long, k As Long
   
4.     Range("C2:G5").ClearContents
   
5.     With Sheets("表1")
   
6.         arr1 = .Range("A2:F" & .[a65536].End(xlUp).Row)
   
7.         arr2 = .Range("G2:K" & .[g65536].End(xlUp).Row)
   
8.     End With
   
9.     n = Cells(1, 1)
   
10.     ReDim arr3(1 To 4, 1 To 5)
    
11.     arr4 = Range("B2:B5")
    
12.     For i = 1 To UBound(arr1)
    
13.         If VBA.Day(arr1(i, 1)) = n Then
    
14.             For j = 1 To 4
    
15.                 If arr1(i, 2) = arr4(j, 1) Then
    
16.                     For k = 1 To 4
    
17.                         arr3(j, k) = arr1(i, 2 + k)
    
18.                     Next k
    
19.                     arr3(j, 5) = arr2(n, j + 1)
    
20.                 End If
    
21.             Next j
    
22.         End If
    
23.     Next i
    
24.     Range("C2").Resize(4, 5) = arr3
    
25. End Sub
    
26. 
    

复制代码

附件：    查找数据-sunjing.rar (13.13 KB, 下载次数: 17)

2012-1-8 22:47 上传

点击文件名下载附件

跳转到最佳答案楼层

sunjing-zxl

1. Sub czsj()
   
2.     Dim arr1, arr2, arr3, arr4
   
3.     Dim i As Long, j As Long, n As Long, k As Long
   
4.     Range("C2:G5").ClearContents
   
5.     With Sheets("表1")
   
6.         arr1 = .Range("A2:F" & .[a65536].End(xlUp).Row)
   
7.         arr2 = .Range("G2:K" & .[g65536].End(xlUp).Row)
   
8.     End With
   
9.     n = Cells(1, 1)
   
10.     ReDim arr3(1 To 4, 1 To 5)
    
11.     arr4 = Range("B2:B5")
    
12.     For i = 1 To UBound(arr1)
    
13.         If VBA.Day(arr1(i, 1)) = n Then
    
14.             For j = 1 To 4
    
15.                 If arr1(i, 2) = arr4(j, 1) Then
    
16.                     For k = 1 To 4
    
17.                         arr3(j, k) = arr1(i, 2 + k)
    
18.                     Next k
    
19.                     arr3(j, 5) = arr2(n, j + 1)
    
20.                 End If
    
21.             Next j
    
22.         End If
    
23.     Next i
    
24.     Range("C2").Resize(4, 5) = arr3
    
25. End Sub
    
26. 
    

复制代码

附件：    查找数据-sunjing.rar (13.13 KB, 下载次数: 17)

2012-1-8 22:47 上传

点击文件名下载附件