当前位置：首页 → 问答吧 → 麻烦帮忙由一系列数据中输出相应项目相关指标

麻烦帮忙由一系列数据中输出相应项目相关指标

时间：2011-08-12

来源：互联网

现在想由一个表格中提取数据，输出另一个表格匹配，数据与输出表格格式请看附件，不胜感激

附件

信息表.rar(8.31 KB)

2011-8-12 12:02, 下载次数: 15

作者: you802127 发布时间: 2011-08-12

复制内容到剪贴板

代码:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$A$1" Then Exit Sub
Application.EnableEvents = False
Dim c, m%, j%, k%, v(1 To 17, 0 To 2)
For Each c In Sheets("数据").Range("b3:b36")
If c = [a1] Then: c = Sheets("数据").Cells(c.Row, 3).Resize(1, 51): Exit For
Next
With Sheets("完成效果")
For j = 1 To 17
   For m = 0 To 2
      k = k + 1
      v(j, m) = c(1, k)
   Next
Next
.[B4].Resize(17, 3) = v
End With
Application.EnableEvents = True
End Sub

作者: 白云2011 发布时间: 2011-08-12

复制内容到剪贴板

代码:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Address <> "$A$1" Then Exit Sub
Dim Arr, i&, Brr(1 To 17, 1 To 3)
Arr = Sheet1.[a1].CurrentRegion
Set r1 = Sheet1.[b:b].Find(Target.Value)
For i = 3 To UBound(Arr, 2) Step 3
For j = 0 To 2
Brr(i / 3, j + 1) = Arr(r1.Row, i + j)
Next
Next
[b4].Resize(17, 3) = ""
[b4].Resize(17, 3) = Brr
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target.Address <> "$A$1" Then Exit Sub
Dim Arr, i&
Arr = Sheet1.[a1].CurrentRegion
For i = 3 To UBound(Arr)
cp = cp & Arr(i, 2) & ","
Next
With Target.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
Operator:=xlBetween, Formula1:=cp
End With
End Sub

作者: 蓝桥玄霜发布时间: 2011-08-12

请见附件。