这段代码哪出错了？忘了附件，现在补上来了，不好意思，出了低级错误

bbcc100

             本工作簿只有二张工作表，分别是《查询》《余额表》
       当《查询》N2单元格输入，比如“城”字时，在《余额表》C列查到包含“城”的行次，把《余额表》B、C、H、I列相应的信息提取出来，放到《查询》表的O、P、Q、R列（这点已实现）
       再在《查询》N3单元格输入，比如“林”字时，再把《查询》表P列包含“林”字的《查询》表的O、P、Q、R列对应的行次留下来（这一点，不知哪的代码有问题，不能实现？）

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Address <> [n2].Address Then Exit Sub
    cxnr = Sheet11.[n2]
    If cxnr = "" Then Exit Sub

    r = Sheet3.[b1048576].End(3).Row - 1
    arr = Sheet3.Range("B2:I" & r + 1)
    For i = 1 To r
        If InStr(1, arr(i, 2), cxnr) > 0 Then
            n = n + 1
            arr(n, 1) = arr(i, 1)
            arr(n, 2) = arr(i, 2)
            arr(n, 3) = arr(i, 7)
            arr(n, 4) = arr(i, 8)
        End If
    Next
    Sheet11.[o2:r1048576].Clear
    If n > 0 Then Sheet11.[o2].Resize(n, 4) = arr


    '==================================================
    If Target.Address = [n3].Address Then 'Exit Sub
    cxnr1 = Sheet11.[n3]
    If cxnr1 = "" Then Exit Sub
    r = Sheet11.[p1048576].End(3).Row - 1
    arr = Sheet11.Range("o2:R" & r + 1)
    For i = 1 To r
        If InStr(1, arr(i, 2), cxnr1) > 0 Then
            n = n + 1
            For j = 1 To 4
                arr(n, j) = arr(i, j)
            Next
        End If
    Next
    Sheet11.[o2:r1048576].Clear
    If n > 0 Then Sheet11.[o2].Resize(n, 4) = arr
End If
End Sub

sj15627581616

每次看问题，都先看看有没有附件，没有附件都没有看的心思

liulang0808

If Target.Address <> [n2].Address Then Exit Sub
在N3输入内容，change事件下面的代码不会执行吧？

bbcc100

http://club.excelhome.net/thread-1525820-1-1.html对不起，我没注意到附件没发送成功，现在才看到，补上来了，方便的话，能帮助吗？谢谢。

northwolves

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim arr, brr(), i&, r&
   
3.     If Target.Count > 1 Then Exit Sub
   
4.     If Target.Address = "$N$2" Then
   
5.         cxnr = [n2]
   
6.         If cxnr = "" Then Exit Sub
   
7. 
   
8.         r = Sheet3.[b1048576].End(3).Row - 1
   
9.         arr = Sheet3.[b2].Resize(r, 8)
   
10.         n = 0
    
11.         For i = 1 To r
    
12.             If InStr(arr(i, 2), cxnr) > 0 Then
    
13.                 n = n + 1
    
14.                 arr(n, 1) = arr(i, 1)
    
15.                 arr(n, 2) = arr(i, 2)
    
16.                 arr(n, 3) = arr(i, 7)
    
17.                 arr(n, 4) = arr(i, 8)
    
18.             End If
    
19.         Next
    
20.         [o2:r1048576].Clear
    
21.         If n Then [o2].Resize(n, 4) = arr
    
22. 
    
23.     End If
    
24.     '==================================================
    
25.     If Target.Address = "$N$3" Then    'Exit Sub
    
26.         cxnr1 = Sheet11.[n3]
    
27.         If cxnr1 = "" Then Exit Sub
    
28.         r = Sheet11.[p1048576].End(3).Row - 1
    
29.         arr = Sheet11.[o2].Resize(r, 4)
    
30.         ReDim brr(1 To r, 1 To 4)
    
31.         n = 0
    
32.         For i = 1 To r
    
33.             If InStr(arr(i, 2), cxnr1) > 0 Then
    
34.                 n = n + 1
    
35.                 For j = 1 To 4
    
36.                     brr(n, j) = arr(i, j)
    
37.                 Next
    
38.             End If
    
39.         Next
    
40.         Sheet11.[o2].Resize(r, 4) = brr
    
41.     End If
    
42. End Sub
    

复制代码

sj15627581616

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Count > 1 Then Exit Sub
   
3. If Target.Address = [n2].Address Or Target.Address = [n3].Address Then
   
4. Sheet1.[o2:r1048576].Clear
   
5. If Target = "" Then Exit Sub
   
6.     arr = Sheet2.UsedRange
   
7.     r = Sheet2.UsedRange.Rows.Count
   
8.     t = 2
   
9.     brr = Sheet1.Range("o1:r" & r)
   
10.     For i = 2 To UBound(arr)
    
11.         If InStr(1, arr(i, 3), Range("n2")) > 0 Then
    
12.             brr(t, 1) = arr(i, 2)
    
13.             brr(t, 2) = arr(i, 3)
    
14.             brr(t, 3) = arr(i, 8)
    
15.             brr(t, 4) = arr(i, 9)
    
16.             t = t + 1
    
17.         End If
    
18.     Next
    
19.     Sheet1.Range("o1:r" & r) = brr
    
20.     Else
    
21.     Exit Sub
    
22.     End If
    
23. End Sub
    

复制代码

猜一下，是不是这个意思

liulang0808

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Address = [n2].Address Then
        cxnr = Sheet11.[n2]
        If cxnr = "" Then Exit Sub
   
        r = Sheet3.[b1048576].End(3).Row - 1
        arr = Sheet3.Range("B2:I" & r + 1)
        For i = 1 To r
            If InStr(1, arr(i, 2), cxnr) > 0 Then
                n = n + 1
                arr(n, 1) = arr(i, 1)
                arr(n, 2) = arr(i, 2)
                arr(n, 3) = arr(i, 7)
                arr(n, 4) = arr(i, 8)
            End If
        Next
        Sheet11.[o2:r1048576].Clear
        If n > 0 Then Sheet11.[o2].Resize(n, 4) = arr

    Else
    '==================================================
        If Target.Address = [n3].Address Then 'Exit Sub
            cxnr1 = Sheet11.[n3]
            If cxnr1 = "" Then Exit Sub
                r = Sheet11.UsedRange.Rows.Count
                arr = Sheet11.Range("o2:R" & r + 1)
                For i = 1 To r
                    If InStr(1, arr(i, 2), cxnr1) > 0 Then
                        n = n + 1
                        For j = 1 To 4
                            arr(n, j) = arr(i, j)
                        Next
                    End If
                Next
                Sheet11.[o2:r1048576].Clear
                If n > 0 Then Sheet11.[o2].Resize(n, 4) = arr
        End If
    End If
End Sub

liulang0808

附件内容供参考。。。。。。

media888

Private Sub CommandButton1_Click()


    'If Target.Count > 1 Then Exit Sub
   ' If Target.Address <> [n2].Address Then Exit Sub
    cxnr = Sheet11.[n2]
    If cxnr = "" Then Exit Sub

    r = Sheet3.[b1048576].End(3).Row - 1
    arr = Sheet3.Range("B2:I" & r + 1)
    For i = 1 To r
        If InStr(1, arr(i, 2), cxnr) > 0 Then
            n = n + 1
            arr(n, 1) = arr(i, 1)
            arr(n, 2) = arr(i, 2)
            arr(n, 3) = arr(i, 7)
            arr(n, 4) = arr(i, 8)
        End If
    Next
    Sheet11.[o2:r1048576].Clear
    If n > 0 Then Sheet11.[o2].Resize(n, 4) = arr


    '==================================================
   
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Selection.Column <> 14 Then Sheet11.[o2:r1048576].Clear

If Selection.Column = 14 Then Call CommandButton1_Click


End Sub