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

毕加猪2016

请大大们帮助修改一下表格如下内容：


各品牌价格查询.rar (200.03 KB, 下载次数: 10)

2016-7-18 21:22 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

老司机带带我

2016-7-19 20:19

附件

跳转到最佳答案楼层

毕加猪2016

请大大们帮助，谢谢

老司机带带我

只是实现了对应的功能：

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. If Target.Address = "$B$7" Then
   
7.     If Target = "" Then Exit Sub
   
8.     With Sheets(Target.Value & "")
   
9.         Arr = .UsedRange
   
10.         For j = 1 To UBound(Arr, 2)
    
11.             If Arr(1, j) = "邮箱容量" Then d(Arr(2, j)) = j
    
12.         Next
    
13.     End With
    
14.     [C10] = ""
    
15.     With Target.Offset(0, 1).Validation
    
16.         .Delete
    
17.         .Add 3, 1, 1, Join(d.keys, ",")
    
18.     End With
    
19. ElseIf Target.Address = "$C$7" Then
    
20.     If Target = "" Then Exit Sub
    
21.     With Sheets(Target.Offset(0, -1).Value & "")
    
22.         Arr = .UsedRange
    
23.         For j = 1 To UBound(Arr, 2)
    
24.             If Arr(1, j) = "邮箱容量" Then d(Arr(2, j)) = j
    
25.         Next
    
26.     End With
    
27.      col = d(Target.Value)
    
28.      d1.RemoveAll
    
29.         For j = 3 To UBound(Arr)
    
30.             d1(Arr(j, 1)) = Arr(j, col + 1)
    
31.         Next
    
32.        k = d1.keys: t = d1.items
    
33. ElseIf Target.Address = "$B$10" Then
    
34.     If Target = "" Then
    
35.         [C10] = ""
    
36.         Exit Sub
    
37.     End If
    
38.     If d1.exists(CDbl(Target.Value)) Then
    
39.         If d1(Target.Value) = "" Then
    
40.             MsgBox "没有对应价格。请尝试输入5的倍数；大于100用户请输入50的倍数"
    
41.         End If
    
42.         [C10] = d1(Target.Value)
    
43.     Else
    
44.         [C10] = ""
    
45.         MsgBox "没有对应价格。请尝试输入5的倍数；大于100用户请输入50的倍数"
    
46.     End If
    
47. End If
    
48. End Sub

复制代码

毕加猪2016

老司机带带我 发表于 2016-7-19 08:50
只是实现了对应的功能：

覆盖原来的全部代码吧？

毕加猪2016

老司机带带我 发表于 2016-7-19 08:50
只是实现了对应的功能：

大大，我是全部覆盖原来的代码的。选择切换品牌或是版本的时候会有424错误。价格怎么也没有自动填充出来啊。

毕加猪2016

老司机带带我 发表于 2016-7-19 08:50
只是实现了对应的功能：

我把您的代码覆盖了原来中间那段。其他功能可以用，就是“当版本选择完毕后自动填充该版本B10数值对应的价格，而不需要双击B10或再输入一次数值C10才会填充改变。”这个还是要重新输入数据才会填充

毕加猪2016

大大们，可以帮助调整一下么

毕加猪2016

大大们，可以帮助调整一下么

老司机带带我

毕加猪2016 发表于 2016-7-19 09:08
我把您的代码覆盖了原来中间那段。其他功能可以用，就是“当版本选择完毕后自动填充该版本B10数值对应的价 ...

这个问题没理解，我B10中选择了相关的数据后C10是根据B10的结果自动出来的，这个程序已经能实现，不需要双击触发！至于报错是因为你定义的字典d1是在Worksheet_SelectionChange中set的，你没有SelectionChange则d1就是空值！

毕加猪2016

老司机带带我 发表于 2016-7-19 13:24
这个问题没理解，我B10中选择了相关的数据后C10是根据B10的结果自动出来的，这个程序已经能实现，不需要双 ...

比如：我选择“网易”-“商务版”，然后在B10输入“5”，则C10填充为"1000",

当我再重新选择切换到“旗舰版”的时候，C10还是显示的是"1000”

我在B10单元格双击一下或者再输入一下"5"，则C10才会填充对应的值“1500”


这是同品牌不同版本的切换，不同品牌切换也是一样，只要B10有数据，选择完版本后就自动填充该版本对应的值。而不需要再双击一下B10或者重新输入一次C10才会变。

您说的那个空值是要删除哪一段代码么？