vba 如果单元格范围不为空，则复制行
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/7741892/
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 Row If Cell Range Are Not Blank
提问by IRHM
I wonder whether someone may be able to help me please.
我想知道是否有人可以帮助我。
I have an Excel (2003) spreadsheet called 'Input' with data in columns B to N. What I would like to be able to do is if there is text in any of the cells in column B, I would like to copy the row but only columns 'B' 'I' and 'N' and paste them into my second spreadsheet called 'Output' at cell ref B2.
我有一个名为“输入”的 Excel (2003) 电子表格，其中包含 B 到 N 列中的数据。我希望能够做的是，如果 B 列中的任何单元格中有文本，我想复制该行但只有列“B”、“I”和“N”并将它们粘贴到我的第二个电子表格中，在单元格引用 B2 处名为“输出”。
If at all possible, once the information has been pasted, I'd like to add the word 'Scheduled site' in column 'E' on the 'Output' sheet if the cells in column 'B' have text in them.
如果可能的话，一旦粘贴了信息，如果“B”列中的单元格中有文本，我想在“输出”表的“E”列中添加“预定站点”一词。
I've been doing this manually, and it takes quite some time to do.
我一直在手动执行此操作，需要相当长的时间才能完成。
I just wondered whether someone may be able to show me please how I can automate this.
我只是想知道是否有人可以向我展示我如何实现自动化。
Many thanks
非常感谢
采纳答案by brettdj
if your data looks like below, and you text entries are not formulae, then this approach will be very fast as it exploits SpecialCells to avoid looping rows
如果您的数据如下所示，并且您的文本条目不是公式，那么这种方法将非常快，因为它利用 SpecialCells 来避免循环行
Sub MoveEM2()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Set ws1 = Sheets("Input")
Set ws2 = Sheets("Output")
On Error Resume Next
Set rng1 = ws1.Columns("B").SpecialCells(xlConstants)
On Error GoTo 0
If rng1 Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set rng2 = ws2.[b2]
rng1.Copy rng2
'copy column I to Output C2
rng1.Offset(0, 7).Copy rng2.Offset(0, 1)
'copy column N to Output d2
rng1.Offset(0, 12).Copy rng2.Offset(0, 2)
rng2.Offset(0, 3).Resize(rng1.Cells.Count, 1) = "Scheduled Site"
Application.ScreenUpdating = True
End Sub
[updated for further query]
[更新以供进一步查询]
Sub MoveEM()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim rng1 As Range
Set ws1 = Sheets("Input")
Set ws2 = Sheets("Output")
On Error Resume Next
Set rng1 = ws1.Range(ws1.[b4], ws1.Cells(Rows.Count, "B").End(xlUp)).SpecialCells(xlConstants)
On Error GoTo 0
If rng1 Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Set rng2 = ws2.[b2]
rng1.Copy
rng2.PasteSpecial xlPasteValues
'copy column I to Output C2
rng1.Offset(0, 7).Copy
rng2.Offset(0, 1).PasteSpecial xlPasteValues
'copy column N to Output d2
rng1.Offset(0, 12).Copy
rng2.Offset(0, 2).PasteSpecial xlPasteValues
rng2.Offset(0, 3).Resize(rng1.Cells.Count, 1) = "Scheduled Site"
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
回答by baochan
I was looking to do the same in a Google Docs spreadsheet so macros were out, I managed to do it with some IFs and VLOOKUPs. It seems a bit convoluted, maybe someone has a more effective way to do this, but this should work without macros:
我想在 Google Docs 电子表格中做同样的事情，所以宏已经出来了，我设法用一些 IF 和 VLOOKUP 来做到这一点。这似乎有点令人费解，也许有人有更有效的方法来做到这一点，但这应该可以在没有宏的情况下工作：
To the left of the input, I created a column starting with 0 and incrementing every time column B has data in it:
在输入的左侧，我创建了一个从 0 开始的列，并且每次 B 列中有数据时递增：
A1=0
A2=IF(ISBLANK(B2),A1,A1+1)
A3=IF(ISBLANK(B3),A2,A2+1)
...
so the first sheet looks like this:
所以第一张纸看起来像这样：
0
1 data1
1
2 data2
3 data3
3
3
4 data4
Then on the output sheet, have a column with simply incrementing values and do a vlookup for the first row containing that number:
然后在输出表上，有一个简单递增值的列，并对包含该数字的第一行进行 vlookup：
A1=1
A2=2
...
and
和
B1=VLOOKUP(A1,Sheet1!A:B,2,FALSE)
B2=VLOOKUP(A2,Sheet1!A:B,2,FALSE)
...
So the second sheet looks like this:
所以第二张纸看起来像这样：
1 data1
2 data2
3 data3
4 data4
Do another vlookup for any other columns you want to transfer from the first sheet, then hide the columns with the numbers in them.
对要从第一张工作表转移的任何其他列进行另一次 vlookup，然后隐藏其中包含数字的列。
回答by Robert Ilbrink
IRHM,
爱尔兰共和军，
Just in case, you know how to handle this here is an example. Remember, everyone does things differently, so this is probably not the fastest or most elegant way.
以防万一，您知道如何处理这里是一个示例。请记住，每个人做事的方式都不一样，所以这可能不是最快或最优雅的方式。
Sub MoveData()
Sheets("Output").Select
'Select the input sheet
OutputRowCounter = Range("A65536").End(xlUp).Row + 1
'find the last used row in column A of the output sheet
Sheets("Input").Select 'Select the input sheet
InputMaxRow = Range("A65536").End(xlUp).Row 'find the last used row in column A of the input sheet
For rowLoop = 2 To InputMaxRow 'loop through the file and copy data from columns B-N to output A-M
If Cells(rowLoop, 2).Value <> "" Then 'if the current cell (changing row and fixed column B) has any data...
For ColLoop = 2 To 14 'Loop through columns B-N
Worksheets("Output").Cells(OutputRowCounter, ColLoop - 1).Value = Cells(rowLoop, ColLoop).Value 'copy selected data
Next ColLoop 'go to next column
OutputRowCounter = OutputRowCounter + 1 'store the next row in the output sheet
End If
Next rowLoop
End Sub
回答by Excellll
Here's another way to do it. This puts your data in an array and then looks through the array for rows that have values in Column B. This should run a little faster than going through your column/sheet cell by cell, but the difference will probably be noticeable only for large data sets.
这是另一种方法。这会将您的数据放入一个数组中，然后在数组中查找在 B 列中具有值的行。这应该比逐个单元格遍历您的列/工作表运行得快一点，但差异可能仅对于大数据才明显套。
Sub summarize()
Dim sIn As Worksheet, sOut As Worksheet, rIn As Range, rOut As Range
Dim inputdata() As Variant
Dim tmpArr(1 To 3) As Variant
Dim i As Long, outcount As Long
Set sIn = Sheets("Input")
Set sOut = Sheets("Output")
Set rIn = sIn.UsedRange
Set rOut = sOut.Range("B2:D2")
'Loads input data into an array for fast processing.
inputdata = rIn.Value
outcount = 0
'Reads data from inputdata Array and prints selected values from columns B, I, and N on Output sheet row by row.
For i = 1 To UBound(inputdata, 1)
If inputdata(i, 1) <> "" Then
outcount = outcount + 1
tmpArr(1) = inputdata(i, 1)
tmpArr(2) = inputdata(i, 8)
tmpArr(3) = inputdata(i, 13)
rOut.Offset(outcount - 1, 0).Value = tmpArr
Erase tmpArr
End If
Next i
Erase inputdata
'Add "Scheduled Site" to Column E of Output data.
If sOut.Range("B2") <> "" Then
sOut.Range("E2") = "Scheduled Site"
sOut.Range("E2").AutoFill Destination:=sOut.Range("E2", sOut.Range("E2").Offset(outcount - 1, 0))
End If
End Sub
