[已解决]查询代码修改

走进EXCEL

求助:查询代码修改(数组方法),谢谢!! 数组求助.rar (64.7 KB, 下载次数: 19)

2017-3-21 07:33 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

大灰狼1976

2017-3-25 17:07

成本价没做，很简单的，你自己练下手吧。

1. Private Sub Worksheet_Change(ByVal T As Range)
   
2. Dim rng As Range, r&, i&, n#
   
3. If T.Address = "$P$1" Then
   
4.   With Sheets(1)
   
5.     r = .Columns(2).Find(T.Value).Row
   
6.     For i = r To .Rows.Count
   
7.       If .Cells(i, 2) <> "" Then Exit For
   
8.       n = n + .Cells(i, 8) + .Cells(i, 15)
   
9.     Next i
   
10.     i = i - 1
    
11.     Set rng = Union(.Range(.Cells(r, 2), .Cells(i, 2)), .Range(.Cells(r, 4), .Cells(i, 9)), .Range(.Cells(r, 11), .Cells(i, 16)))
    
12.   End With
    
13.   If [a65536].End(3).Row > 4 Then [a1].CurrentRegion.Offset(4).Clear
    
14.   rng.Copy [a5]
    
15. End If
    
16. End Sub

复制代码

跳转到最佳答案楼层

大灰狼1976

成本价没做，很简单的，你自己练下手吧。

1. Private Sub Worksheet_Change(ByVal T As Range)
   
2. Dim rng As Range, r&, i&, n#
   
3. If T.Address = "$P$1" Then
   
4.   With Sheets(1)
   
5.     r = .Columns(2).Find(T.Value).Row
   
6.     For i = r To .Rows.Count
   
7.       If .Cells(i, 2) <> "" Then Exit For
   
8.       n = n + .Cells(i, 8) + .Cells(i, 15)
   
9.     Next i
   
10.     i = i - 1
    
11.     Set rng = Union(.Range(.Cells(r, 2), .Cells(i, 2)), .Range(.Cells(r, 4), .Cells(i, 9)), .Range(.Cells(r, 11), .Cells(i, 16)))
    
12.   End With
    
13.   If [a65536].End(3).Row > 4 Then [a1].CurrentRegion.Offset(4).Clear
    
14.   rng.Copy [a5]
    
15. End If
    
16. End Sub

复制代码