[已解决]指定条件提取数据的问题

小玲玲

附件 提取数据.rar (42.38 KB, 下载次数: 17)

2014-6-7 07:34 上传

点击文件名下载附件
谢谢！

最佳答案

月排行榜 / 总排行榜

zjdh

2014-6-7 09:08

Sub TEST()
    For I = 1 To Range("A65536").End(3).Row
        W = Split(Cells(I, 1), "-")(0)
        Sheets(2).Cells(Right(W, Len(W) - 1), 1).Resize(, 12).Copy Cells(I, 8)
    Next
End Sub
提取数据.rar (27.36 KB, 下载次数: 22)

2014-6-7 09:10 上传

点击文件名下载附件

跳转到最佳答案楼层

zjdh

Sub TEST()
    For I = 1 To Range("A65536").End(3).Row
        W = Split(Cells(I, 1), "-")(0)
        Sheets(2).Cells(Right(W, Len(W) - 1), 1).Resize(, 12).Copy Cells(I, 8)
    Next
End Sub
提取数据.rar (27.36 KB, 下载次数: 22)

2014-6-7 09:10 上传

点击文件名下载附件

风林火山

1. Sub test()
   
2.     Dim arr, brr, k%, i%, h%, str%
   
3.     arr = Sheet2.UsedRange
   
4.     brr = Range("a1").CurrentRegion
   
5.     For k = 1 To UBound(brr)
   
6.         h = Val(VBA.Mid(VBA.Left(brr(k, 1), InStr(brr(k, 1), "-") - 1), 2, 99))
   
7.         i = Cells(Rows.Count, "H").End(3).Row + 1
   
8.         Sheet2.Range("a" & h).Resize(1, 12).Copy Range("H" & i)
   
9.     Next
   
10. End Sub

复制代码

zjdh

简单