[已解决]请帮手写段查询的代码，谢谢！

wangby

9999.rar (45.03 KB, 下载次数: 21)

2014-5-25 10:22 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

byhdch

2014-5-25 14:07

1. Private Sub CommandButton1_Click()
   
2.     Dim i As Long, j&
   
3.     Dim arr
   
4.     Application.ScreenUpdating = False  '关闭屏幕刷新
   
5.     For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
   
6.         If Cells(i, "D") <> "" Then
   
7.             With Sheets(Cells(i, 1).Value)
   
8.                 j = .Range("C:C").Find(Cells(i, "D")).Row
   
9.                 arr = .Range(.Cells(j, "M"), .Cells(j, "Y"))
   
10.             End With
    
11.             Cells(i, "N").Resize(, UBound(arr, 2)) = arr
    
12.         End If
    
13.     Next i
    
14.     Application.ScreenUpdating = True   '打开屏幕刷新
    
15. End Sub

复制代码

9999.rar (53.55 KB, 下载次数: 9)

2014-5-25 14:07 上传

点击文件名下载附件

跳转到最佳答案楼层

wangby

是不是我没有说清楚需求呀，如有不明白，告诉我，我马上改呀，谢谢！

byhdch

1. Private Sub CommandButton1_Click()
   
2.     Dim i As Long, j&
   
3.     Dim arr
   
4.     Application.ScreenUpdating = False  '关闭屏幕刷新
   
5.     For i = 3 To Cells(Rows.Count, 1).End(xlUp).Row
   
6.         If Cells(i, "D") <> "" Then
   
7.             With Sheets(Cells(i, 1).Value)
   
8.                 j = .Range("C:C").Find(Cells(i, "D")).Row
   
9.                 arr = .Range(.Cells(j, "M"), .Cells(j, "Y"))
   
10.             End With
    
11.             Cells(i, "N").Resize(, UBound(arr, 2)) = arr
    
12.         End If
    
13.     Next i
    
14.     Application.ScreenUpdating = True   '打开屏幕刷新
    
15. End Sub

复制代码

9999.rar (53.55 KB, 下载次数: 9)

2014-5-25 14:07 上传

点击文件名下载附件

wangby

byhdch 发表于 2014-5-25 14:07

谢谢您！

唉，我何时才可学到你这样的水平呀。

su45

byhdch 发表于 2014-5-25 14:07

j = .Range("C:C").Find(Cells(i, "D")).Row
没考虑找不到的问题吧？如果找不到，就会出错。

byhdch

对代码进行了完善
9999.rar (55.4 KB, 下载次数: 10)

2014-5-25 19:15 上传

点击文件名下载附件