[已解决]怎样提取表格中指定行的数据

gaizi321 · 发表于 2015-5-25 18:48

我录制了一个宏，感觉效果不是很好，我第一行有个选择，当我选对时，我想按下按钮把目标行的内容全部复制过去，不能覆盖新表原有的东西，这样累加，请大神们帮帮忙啊。

最佳答案

冥王

2015-5-25 19:16

Sub demo()
Dim arr, brr(1 To 10000, 1 To 8)
Dim intRow%, i%, k%, j%
With ThisWorkbook.Sheets(1)
intRow = .Cells(Rows.Count, 2).End(xlUp).Row
arr = .Range("A2:I" & intRow)
For i = 2 To intRow - 2
If arr(i, 1) = "√" Then
k = k + 1
For j = 1 To 8
brr(k, j) = arr(i, j + 1)
Next
End If
Next
End With
Workbooks.Open ThisWorkbook.Path & "\新.xls"
Workbooks("新.xls").Sheets(1).Cells(1, 1).Resize(1, 8) = Array("序号", "设备名称", "设备型号/规格", "单位", "数量", "单价（元）", "合价（元）", "备注")
Workbooks("新.xls").Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(k, 8) = brr
End Sub

复制代码

冥王 · 发表于 2015-5-25 19:16

Sub demo()
Dim arr, brr(1 To 10000, 1 To 8)
Dim intRow%, i%, k%, j%
With ThisWorkbook.Sheets(1)
intRow = .Cells(Rows.Count, 2).End(xlUp).Row
arr = .Range("A2:I" & intRow)
For i = 2 To intRow - 2
If arr(i, 1) = "√" Then
k = k + 1
For j = 1 To 8
brr(k, j) = arr(i, j + 1)
Next
End If
Next
End With
Workbooks.Open ThisWorkbook.Path & "\新.xls"
Workbooks("新.xls").Sheets(1).Cells(1, 1).Resize(1, 8) = Array("序号", "设备名称", "设备型号/规格", "单位", "数量", "单价（元）", "合价（元）", "备注")
Workbooks("新.xls").Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(k, 8) = brr
End Sub

复制代码

gaizi321 · 发表于 2015-5-26 18:20

冥王发表于 2015-5-25 19:16

非常好用，谢谢了。有没有方法能把你写的东西批量发送到我需要的表格中，我一个一个粘贴太慢了，数据有点多。

广陵王 · 发表于 2015-5-31 23:27

谢谢老师!学习了

		自动登录	找回密码
密码			注册