求助老师帮忙，想了好多天只能完成这样

a316667229

求老师帮忙.rar (150.08 KB, 下载次数: 5)

2017-9-20 17:23 上传

点击文件名下载附件

求助那位老师帮帮忙，想了很多天只完成这样，本人对VBA还是很不熟，现在出现了几个问题，都写在表格里面，请那位老师帮忙处理一下，在此谢谢！

砂海

Private Sub Worksheet_Change(ByVal Target As Range) '单元格改变事件
If Target.Count > 1 Then Exit Sub '单元格发生改变的个数超过1个 则退出程序
If Target.Column <> 4 Or Target.Row < 2 Then Exit Sub '如果不是D列 , 或者行号<2 , 退出程序

针对你的问题 1,2 这样回答.
你不是不熟 , 是生吞别人的 , 还没消化

a316667229

砂海 发表于 2017-9-20 18:19
Private Sub Worksheet_Change(ByVal Target As Range) '单元格改变事件
If Target.Count > 1 Then Exit S ...

嗯，那老师能不能帮我改一下呢

a316667229

a316667229 发表于 2017-9-20 18:22
嗯，那老师能不能帮我改一下呢

Private Sub Worksheet_Change(ByVal Target As Range)        '私有的子程序 Worksheet_Change(变量Target 为 单元格区域)
If Target.Count > 1 Then Exit Sub                          '如果 Target.Count>1 则执行 退出子程序
    If Target.Column <> 4 Or Target.Row < 2 Then Exit Sub   '如果 Target.Column<>4或者Target.Row<2 则执行 退出子程序
       Dim Arr, i&, d, t, aa, j&, n&                        '定义变量 Arr,i&,d,t,aa,j&,n&
       Set d = CreateObject("Scripting.Dictionary")         '设定d=创建对象("Scripting.Dictionary")
       Arr = [a1].CurrentRegion                             'Arr=[a1的当前区域
       For i = 2 To UBound(Arr)                             '设定变量范围为i=2到UBound(Arr)
          d(Arr(i, 1)) = d(Arr(i, 1)) & Arr(i, 2) & ","     'd(Arr(i,1))=d(Arr(i,1)) & Arr(i,2) & ","
       Next                                                 '下一个
       If d.exists(Target.Value) Then                       '如果 d.exists(Target.Value) 则执行
          t = d(Target.Value)                               't=d(Target.Value)
          n = Target.Row                                    'n=Target.Row
          t = Left(t, Len(t) - 1)                           't=左侧(t,Len(t)-1)
          If InStr(t, ",") Then                             '如果 InStr(t,",") 则执行
             aa = Split(t, ",")                             'aa=Split(t,",")
             For j = 0 To UBound(aa)                        '设定变量范围为j=0到UBound(aa)
                Cells(n + j, 5) = aa(j)                     '单元格集合(n+j,5)=aa(j)
             Next                                           '下一个
             Else                                           '否则
             Cells(n, 5) = t                                '单元格集合(n,5)=t
          End If                                            'End如果
          Else                                              '否则
                                                            '
       End If                                               'End如果
End Sub                                                    'End子程序
这语句没错啊，可不知道为何会出现每次刷新数据就要在D2双击后按回车才会刷出来要查询找的数据，而且E列的数据也要手工去掉，才会重新出来，不然就覆盖或者遗留上一次的数据

大灰狼1976

公式内的数值变化不会触发change事件。

a316667229

大灰狼1976 发表于 2017-9-21 10:42
公式内的数值变化不会触发change事件。

能否帮忙修改一下，老师，确实N天不会弄，恳请帮帮忙