如果单元格范围不为空，则复制行

Question

我想知道是否有人可以帮助我。

我有一个名为“输入”的 Excel（2003）电子表格，其中的数据位于 B 至 N 列中。我想要做的是，如果 B 列中的任何单元格中有文本，我想复制该行但只有“B”、“I”和“N”列，并将它们粘贴到我的第二个电子表格中，称为“输出”，位于单元格引用 B2 处。

如果可能的话，一旦粘贴信息，如果“B”列中的单元格中有文本，我想在“输出”表的“E”列中添加“预定站点”一词。

我一直在手动执行此操作，并且需要相当长的时间才能完成。

我只是想知道是否有人可以向我展示如何自动化此操作。

非常感谢

Answer 1

如果您的数据如下所示，并且您的文本条目不是公式，那么这种方法将非常快，因为它利用 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

[已更新以供进一步查询]

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

Answer 2

我想在 Google Docs 电子表格中做同样的事情，所以宏已经消失了，我设法用一些 IF 和 VLOOKUP 来做到这一点。这看起来有点复杂，也许有人有更有效的方法来做到这一点，但这应该在没有宏的情况下工作：

在输入的左侧，我创建了一个以 0 开头的列，并在每次 B 列中有数据时递增：

A1=0
A2=IF(ISBLANK(B2),A1,A1+1)
A3=IF(ISBLANK(B3),A2,A2+1)
...

所以第一个工作表如下所示：

0    
1    data1
1
2    data2
3    data3
3    
3
4    data4

然后在输出工作表上，有一列仅递增值，并对包含该数字的第一行执行 vlookup：

A1=1
A2=2
...

因此

B1=VLOOKUP(A1,Sheet1!A:B,2,FALSE)
B2=VLOOKUP(A2,Sheet1!A:B,2,FALSE)
...

第二个工作表如下所示：

1    data1
2    data2
3    data3
4    data4

对您想要的任何其他列执行另一个 vlookup从第一张纸转移，然后隐藏其中包含数字的列。

Answer 3

IRHM，

以防万一，你知道如何处理这个问题，这里有一个例子。请记住，每个人做事的方式都不同，所以这可能不是最快或最优雅的方式。

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

Answer 4

这是另一种方法。这会将您的数据放入一个数组中，然后在数组中查找在 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