输入一个单元格,其它的相关内容自动弹出,并且看不到公式

sylbxx

求教:输入一个单元格,其它的相关内容自动弹出,并且看不到公式,是如何作到的?
22.rar (17.48 KB, 下载次数: 45)

2012-5-1 18:55 上传

点击文件名下载附件

SuperBirds

通过Worksheet_Change事件实现，楼主附件中的VBA代码有详细的说明

zez

用代码实现的：
Private Sub Worksheet_Change(ByVal Target As Range)         '单元格变更启动的程序
    c = Target.Column                                       '取变更单元格的列数
    r = Target.Row                                          '取变更单元格的行数
    v = Target.Value                                        '取变更单元格的值
    If r < 2 Then Exit Sub                                  '如果行数小于1退出
    If Cells(r, 2).Value = "" Then Exit Sub        '当第一单元格值为空时退出
    Dim rg As Range                                         '定义一个单元格变量
    With Worksheets("商家")                                 '使用“代码”表
        If c = 2 Then                             '如果变更单元格的列数是1、32
            ed = .[B10000].End(xlUp).Row                    '找出“代码”表最后一行的行数
            Set rg = .Range("B1:B" & ed).Find(Target.Value, LookIn:=xlValues) '在“代码”表a列第一行至最末行中找与变更单元格相同的值
            If rg Is Nothing Then Exit Sub                  '如果没找到退出
            r0 = rg.Row                                     '取找到行的行数
            Do While v <> rg.Value                          '
                Set rg = .Range("B1:B" & ed).FindNext(rg)   '
                If rg.Row = r0 Then Exit Sub                '变更单元格值没找到时不改变退出
            Loop
            h = rg.Row                                      '取找到行的行数
            Cells(r, c + 1).Value = .Range("C" & h)         '变更单元格所在行g列变为“代码”表找到行的c列
            Cells(r, c + 2).Value = .Range("D" & h)         '变更单元格所在行g列变为“代码”表找到行的c列
            Cells(r, c - 1).Value = .Range("A" & h)         '变更单元格所在行g列变为“代码”表找到行的c列
        End If                                              '第6、32列变更处理结束
    End With
   
On Error Resume Next
If Target.Column = 1 And Target.Value = "" _
And Target.Offset(0, 5).Value = "" Then Exit Sub
If Target.Column = 1 And Target.Value = "" _
And Target.Offset(0, 5).Value <> "" Then
Target.Offset(0, 5).Value = del
End If
If Target.Column = 1 And Target.Value <> "" _
And Target.Offset(0, 5).Value = "" Then  '当第11列不为空时自动填充第1列日期
Target.Offset(0, 5).Value = Date
End If
End Sub

sylbxx

太谢谢楼上的二位了,Thank you very much ,Thank you very much,,Thank you very much,,Thank you very much

sylbxx

SuperBirds 发表于 2012-5-1 19:28
通过Worksheet_Change事件实现，楼主附件中的VBA代码有详细的说明

太谢谢了,十分感谢.....

sylbxx

zez 发表于 2012-5-1 19:29
用代码实现的：
Private Sub Worksheet_Change(ByVal Target As Range)         '单元格变更启动的程序
  ...

太谢谢了,十分感谢.....