如何从其他表格提取出指定的数据！请各位大神进来帮忙！

hmc530

如何从【数据源】表格一键提取出右边的这些数据？ 例子.zip (722.18 KB, 下载次数: 8)

2018-3-11 12:26 上传

点击文件名下载附件

hmc530

请各位老师帮帮我下咯！！十分感谢啊

abc123281

呵呵 很容易实现   你想用代码还是函数公式?    如果想用VBA代码       请到vba板块求助

hmc530

abc123281 发表于 2018-3-11 13:42
呵呵 很容易实现   你想用代码还是函数公式?    如果想用VBA代码       请到vba板块求助

公式如何体现？

abc123281

如果用公式很麻烦   你的表中由合并单元格

鄂龙蒙

用代码容易些。

wzqufan

我晕。。。你把不需要的那些隐藏掉 然后复制需要的  粘贴不就行了。。。。

abc123281

仅供参考

1. Sub 提取()
   
2. Dim arr, brr(1 To 10000, 1 To 4)
   
3. With Worksheets("数据源")
   
4.    rw = .[b65536].End(3).Row
   
5.    arr = .Range("a3:ad" & rw)
   
6. For i = 1 To UBound(arr)
   
7.   n = n + 1
   
8.   For j = 1 To UBound(arr, 2)
   
9.       brr(n, 1) = arr(i, 3)
   
10.       brr(n, 2) = arr(i, 2)
    
11.       brr(n, 3) = arr(i, 6)
    
12.       brr(n, 4) = arr(i, 30)
    
13.   Next
    
14. Next
    
15. End With
    
16. With Worksheets("提取数据")
    
17.    .[a2].Resize(n, 4) = brr
    
18.     rw = .[b65536].End(3).Row
    
19.     arr = .Range("b1:d" & rw)
    
20.     For i = 2 To UBound(arr) - 1
    
21.        For x = i + 1 To UBound(arr)
    
22.           If arr(x, 2) = "" Then
    
23.              Cells(x, 3) = arr(i, 2)
    
24.           Else
    
25.              i = x
    
26.           End If
    
27.           If arr(x, 3) = "" Then
    
28.              Cells(x, 4) = arr(i, 3)
    
29.           Else
    
30.              i = x
    
31.           End If
    
32.        Next
    
33.        If x >= UBound(arr) Then Exit For
    
34.     Next
    
35. End With
    
36. MsgBox "提取数据完成！"
    
37. End Sub

复制代码

abc123281

参考附件





例子abc123.rar (687.3 KB, 下载次数: 8)

2018-3-11 16:58 上传

点击文件名下载附件

hmc530

abc123281 发表于 2018-3-11 16:58
参考附件