求助：2个条件查询VBA程序修订

bxg117

求助：2个条件查询VBA程序修订
根据“指令”中产品名称（C3）和批号（C4），将“苹果表”中符合条件结果放到“苹果表”黄色区域！这样指令表中两个条件变动，苹果表根据这两个条件也变动！！
在“指令表”中已经成功：是搜索多个表放到“指令表”中！！

bxg117

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     Dim r%, i%, m%
   
3.     Dim arr, brr(1 To 18, 1 To 9)
   
4.     Dim ws As Worksheet
   
5.     If Target.Count > 1 Then Exit Sub
   
6.     If Target.Address = "$C$4" Or Target.Address = "$C$3" Then
   
7.         Application.EnableEvents = False
   
8.         With Worksheets("指令")
   
9.             PH = CStr([c4].Value)
   
10.             NM = CStr([c3].Value)
    
11.             arr = Sheets("产品信息").UsedRange
    
12.             For i = 4 To UBound(arr)
    
13.                 If arr(i, 3) = NM Then
    
14.                     For J = 4 To 18
    
15.                         .Cells(J, "Z") = arr(i, J + 5)
    
16.                     Next
    
17.                 End If
    
18.             Next
    
19.             r = .Cells(.Rows.Count, 26).End(xlUp).Row
    
20.             crr = Application.Transpose(.Range("z4:z" & r))
    
21.             For Each x In crr
    
22.                 With Worksheets(x)
    
23.                     r = .UsedRange.Find(what:="*", LookIn:=xlValues, lookat:=xlWhole, searchorder:=xlByRows, searchdirection:=xlPrevious).Row
    
24.                     For i = 5 To r
    
25.                         If .Cells(i, 2) = PH And .Cells(i, 1) = NM Then
    
26.                             r0 = .Cells(i, 5).MergeArea.Row
    
27.                             m = m + 1
    
28.                             brr(m, 1) = m
    
29.                             brr(m, 2) = .Cells(r0, 5)
    
30.                             brr(m, 3) = .Cells(r0, 6)
    
31.                             brr(m, 4) = .Cells(2, 19)
    
32.                             brr(m, 5) = .Cells(r0, 7)
    
33.                             brr(m, 6) = .Cells(2, 20)
    
34.                             brr(m, 7) = .Cells(i, 4)
    
35.                             brr(m, 8) = .Cells(r0, 10)
    
36.                             brr(m, 9) = .Cells(r0, 11) & .Cells(r0, 12)
    
37.                         End If
    
38.                     Next
    
39.                 End With
    
40.             Next
    
41.             .Range("b9").Resize(UBound(brr), UBound(brr, 2)) = brr
    
42.             arr = Sheets("生产计划").Range("A3：K" & Sheets("生产计划").Range("A65536").End(3).Row)
    
43.             For i = 1 To UBound(arr)
    
44.                 If arr(i, 2) = NM And arr(i, 5) = PH Then
    
45.                     .Cells(2, "J") = arr(i, 7)
    
46.                     .Cells(3, "G") = arr(i, 1)
    
47.                     .Cells(4, "G") = arr(i, 4)
    
48.                     .Cells(4, "J") = arr(i, 3)
    
49.                     .Cells(5, "C") = arr(i, 11)
    
50.                     .Cells(6, "J") = arr(i, 6)
    
51.                      Range("J6").NumberFormatLocal = "yyyy""年""m""月""d""日"""
    
52.                 End If
    
53.             Next
    
54.         End With
    
55.         Application.EnableEvents = True
    
56.     End If
    
57. End Sub
    
58. 
    
59. Sub tt()
    
60.     [c4].Formula = Replace("=INDIRECT(@苹果!B@&INDIRECT(@$M$2@)+4)", "@", Chr(34))
    
61. End Sub
    

复制代码

bxg117

无人关注

bxg117

真的不能改！！！