[已解决]搜索填充的VBA程序修改

老司机带带我

[B10],[C10]情况重新选择：

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2.     If Target.Count > 1 Then Exit Sub
   
3.     If Application.Intersect([b7:c7,b10], Target) Is Nothing Then Exit Sub
   
4. Dim i&, Sht As Worksheet, col%, j&
   
5. Set d = CreateObject("Scripting.Dictionary")
   
6. 
   
7. If Target.Address = "$B$7" Then
   
8.     If Target = "" Then Exit Sub
   
9.     With Sheets(Target.Value & "")
   
10.         Arr = .UsedRange
    
11.         For j = 1 To UBound(Arr, 2)
    
12.             If Arr(1, j) = "邮箱容量" Then d(Arr(2, j)) = j
    
13.         Next
    
14.     End With
    
15.     [C10] = ""
    
16.     With Target.Offset(0, 1).Validation
    
17.         .Delete
    
18.         .Add 3, 1, 1, Join(d.keys, ",")
    
19.     End With
    
20. ElseIf Target.Address = "$C$7" Then
    
21.     If Target = "" Then Exit Sub
    
22.     With Sheets(Target.Offset(0, -1).Value & "")
    
23.         Arr = .UsedRange
    
24.         For j = 1 To UBound(Arr, 2)
    
25.             If Arr(1, j) = "邮箱容量" Then d(Arr(2, j)) = j
    
26.         Next
    
27.     End With
    
28.     [C10] = ""
    
29.     [B10] = ""
    
30.      col = d(Target.Value)
    
31.      d1.RemoveAll
    
32.         For j = 3 To UBound(Arr)
    
33.             d1(Arr(j, 1)) = Arr(j, col + 1)
    
34.         Next
    
35.        k = d1.keys: t = d1.items
    
36. ElseIf Target.Address = "$B$10" Then
    
37.     If Target = "" Then
    
38.         [C10] = ""
    
39.         Exit Sub
    
40.     End If
    
41.     If d1.exists(CDbl(Target.Value)) Then
    
42.         If d1(Target.Value) = "" Then
    
43.             MsgBox "没有对应价格。请尝试输入5的倍数；大于100用户请输入50的倍数"
    
44.         End If
    
45.         [C10] = d1(Target.Value)
    
46.     Else
    
47.         [C10] = ""
    
48.         MsgBox "没有对应价格。请尝试输入5的倍数；大于100用户请输入50的倍数"
    
49.     End If
    
50. End If
    
51. End Sub

复制代码

毕加猪2016

老司机带带我 发表于 2016-7-19 17:27
,[C10]情况重新选择：

谢谢您的帮助，可能还有一点问题

现在B10输入用户数后，C10也显示的是用户数，而不是价格！

老司机带带我

附件

毕加猪2016

老司机带带我 发表于 2016-7-19 20:19
附件

感谢大大的帮助！谢谢！