[已解决]-----------------数据关联问题------------------------------------

80013025

数据关联问题.rar (4.59 KB, 下载次数: 45)

2011-9-28 16:45 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

mxg825

2011-9-29 11:04

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Column = 2 And Target.Row > 2 Then
   
3.     Call AA
   
4. End If
   
5. End Sub  '要限制一个单元格区域，等于第2列，大于第2行时！

复制代码

跳转到最佳答案楼层

aa123456aa

Sub AA()
Dim X%, Y%, Z%, M%, K%, G&, D
Set D = CreateObject("Scripting.Dictionary")
With Sheets("HOME首页")
  Y = .Range("B65536").End(3).Row
  ReDim ARR1(1 To Y - 2, 1 To 4)
  arr = .Range("B3:B" & Y)
     For Z = 2 To Sheets.Count
         D.Add Sheets(Z).Range("C2").Value, Z
     Next Z
  For K = 1 To UBound(arr)
      G = D.Item(arr(K, 1))
      For M = 1 To 4
       Set C = Sheets(G).Range("A1:Z65536").Find(.Cells(2, 2 + M), SearchFormat:=True)
         If C Is Nothing Then
            ARR1(K, M) = ""
         Else
            ARR1(K, M) = C.Offset(, 1).Value
        End If
      Next M
  Next K
.Range("C3:F" & Y) = ARR1
End With
End Sub

80013025

回复 aa123456aa 的帖子

大侠如何让这段代码能自动运行，就是在名称位置输入名称后，会自动显示数据，而不用手动去运行代码。
我试着用
Private Sub Worksheet_Change(ByVal Target As Range)

Call AA
End Sub       来启动代码，可总是提示错误。请大侠再帮帮忙！

Sub AA()
Dim X%, Y%, Z%, M%, K%, G&, D
Set D = CreateObject("Scripting.Dictionary")
With Sheets("HOME首页")
   Y = .Range("B65536").End(3).Row
   ReDim ARR1(1 To Y - 2, 1 To 4)
   arr = .Range("B3:B" & Y)
      For Z = 2 To Sheets.Count
          D.Add Sheets(Z).Range("C2").Value, Z
      Next Z
   For K = 1 To UBound(arr)
       G = D.Item(arr(K, 1))
       For M = 1 To 4
        Set C = Sheets(G).Range("A1:Z65536").Find(.Cells(2, 2 + M), SearchFormat:=True)
          If C Is Nothing Then
             ARR1(K, M) = ""
          Else
             ARR1(K, M) = C.Offset(, 1).Value
         End If
       Next M
   Next K
.Range("C3:F" & Y) = ARR1
End With
End Sub

mxg825

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. If Target.Column = 2 And Target.Row > 2 Then
   
3.     Call AA
   
4. End If
   
5. End Sub  '要限制一个单元格区域，等于第2列，大于第2行时！

复制代码

666666666

回复 mxg825 的帖子


mxg825老师请移步：谢谢@#￥！

http://www.excelpx.com/thread-202302-1-1.html

byhdch

学习学习......