vba 如果单元格等于一个值，则复制 Excel 行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/19125372/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Copy Excel Row if Cell is equal to a value
提问by Benjooster
I'm trying to copy and paste into a different workbook and spread that data over different sheets inside of the new workbook. I've got my VBA working, but it only works about 25% of the time. I continually get an error on "Run-time error '1004': Select method of Range class failed".
我正在尝试复制并粘贴到不同的工作簿中，并将该数据分布在新工作簿内的不同工作表中。我的 VBA 可以工作，但它只能在 25% 的时间内工作。我不断收到关于“运行时错误‘1004’：Range 类的选择方法失败”的错误消息。
Here is the script:
这是脚本：
Sub CopyData()
Dim i As Range
For Each i In Range("A1:A1000")
Windows("data_1.xls").Activate
Sheets("data_1").Activate
If i.Value = 502 Then
i.Select
ActiveCell.Rows("1:1").EntireRow.Select
Selection.Copy
Windows("DataOne.xls").Activate
Sheets("502").Range("A39").End(xlUp).Offset(1, 0).PasteSpecial
End If
If i.Value = 503 Then
........
End If
Next i
End Sub
The failure happens on i.Selectevery time. Do I need to bring Next iup to the end of every End If?
故障发生在i.Select每次。我需要提到Next i每一件事的结尾End If吗？
回答by Floris
When you activate another sheet/window, you confuse the loop. The next iends up referring to the next cell in the wrong sheet, which may have no value in.
当您激活另一个工作表/窗口时，您会混淆循环。下一个i最终引用错误工作表中的下一个单元格，其中可能没有任何值。
If you do have to Activate, make sure you go back to the original sheet before the next round in the loop. Which means you REALLY need Application.ScreenUpdating = Falseat the start of your sub, and Application.ScreenUpdating = Trueat the end...
如果必须这样做Activate，请确保在循环中的下一轮之前返回到原始工作表。这意味着你真的需要Application.ScreenUpdating = False在你的潜艇开始时，Application.ScreenUpdating = True在结束时......
回答by David Zemens
You don't need to use Activate, Select, or copy/paste if you just want to transfer values.
如果您只想传输值，则无需使用激活、选择或复制/粘贴。
Sub CopyData()
Dim i As Range
Dim srcBook as Workbook
Dim destBook as Workbook
Application.ScreenUpdating = False
Set srcBook = Workbooks("data_1.xls")
Set destBook = Workbooks("DataOne.xls")
For Each i In srcBook.Sheets("data_1").Range("A1:A1000")
Select Case i.Value
Case 502
destBook.Sheets("502").Range("A39").End(xlUp). _
Offset(1, 0).EntireRow.Value = i.EntireRow.Value
Case 503
destBook.Sheets("503").Range("A39").End(xlUp). _
Offset(1, 0).EntireRow.Value = i.EntireRow.Value
Case 504
'etc
Case Else
'do nothing/ or do something for non-matching
End Select
Next i
Application.ScreenUpdating = True
End Sub
This could maybe be further simplified if I knew more about your If/Thenstructure and the destination of the values (are they all going to a sheet name in the same file, which corresponds to the value of i? If so, this could be even more simple.
如果我更了解您的If/Then结构和值的目的地（它们是否都指向同一个文件中的工作表名称，对应于 的值i？如果是这样，这可能会更简单。
I am curious why you're looping a range of 1000 rows, but only writing to a range of A39 (.End(xlUp))...
我很好奇你为什么要循环 1000 行的范围，但只写入 A39 ( .End(xlUp))的范围......
Updated from comments:
从评论更新：
Sub CopyData()
Dim i As Range
Dim srcBook as Workbook
Dim destBook as Workbook
Set srcBook = Workbooks("data_1.xls")
Set destBook = Workbooks("DataOne.xls")
For Each i In srcBook.Sheets("data_1").Range("A1:A1000")
destBook.Sheets(Cstr(i)).Range("A:A").End(xlUp).Offset(1,0). _
EntireRow.Value = i.EntireRow.Value
Next i
End Sub
You probably don't need to worry about ScreenUpdatingwith this size of an array, and using this direct method to write from/to the destination, it's not nearly as resource-intensive as continuously selecting, activating, copying/pasting and then selecting again, etc.
您可能不需要担心ScreenUpdating数组的大小，并且使用这种直接方法从/向目标写入，它不像连续选择、激活、复制/粘贴然后再次选择那样占用资源，等等。
