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

Question

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

我有一个名为'Input'的Excel（2003）电子表格，其中包含B到N列中的数据。我希望能够做的是如果B列中的任何单元格中都有文本，我想复制行但只有列'B''我'和'N'并将它们粘贴到我的第二个电子表格中，称为'输出'在单元格ref B2。

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

我一直在手动执行此操作，需要花费很长时间才能完成。

我只是想知道是否有人可以告诉我，我可以自动解决这个问题。

非常感谢

Answer 1

我希望在Google文档电子表格中执行相同操作，因此宏已经用完了，我设法使用了一些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 2

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 3

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