复制并粘贴整行

Question

复制并粘贴整行

3

功能：我正在开展一个小项目，需要在一列中搜索每个单元格是否含有“未知”这个词。如果包含该词，则将整行复制到新表中。

问题：我遇到了“对象不支持此属性或方法”的错误。我相信问题出在复制语句（而不是目标）中。这么简单的事却让我无法解决这个问题。

Sub CheckRows()
Dim b As Range
Dim SrchRng As Range

Set b = ActiveWorkbook.Sheets("Sheet 2").Range("A1")
Set SrchRng = ActiveWorkbook.Sheets("Sheet 1").Range("G1")

Do While SrchRng.Value <> ""     
    If SrchRng.Value = "Unknown" Then
        Worksheets("Sheet 1").SrchRng.EntireRow.Copy _
            Destination:=Worksheets("Sheet 2").b
        Set b = b.Offset(1, 0)
        Set SrchRng = SrchRng.Offset(1, 0)
    Else: Set SrchRng = SrchRng.Offset(1, 0)
    End If
Loop

End Sub

- Landen

1

当您遇到错误时，请按住CTRL键并按下PAUSE/BREAK键。这可能会提示您进入调试器。如果是这样，请按DEBUG按钮。它应该会突出显示导致错误的确切代码行。您能告诉我们哪一行代码被突出显示了吗？ - Johnny Bones

1

虽然使用 Do While 循环可以实现复制在 G 列中匹配“Unknown”的行的目标，但使用 Excel 的内置 .Autofilter 方法可能是更好的选择，因为您可以一次性获取所有匹配的行。这是一个 MSDN 链接：http://msdn.microsoft.com/en-us/library/office/ff193884(v=office.15).aspx - Dan Wagner

SrchRng已经包含对ActiveWorkbook.Sheets（“Sheet 1”）的引用，所以我认为您只需使用SrchRng.EntireRow.Copy等即可。b也是同理。 - Matt Cremeens

谢谢你的建议。我已经有一段时间没有使用VBA了，所以我有些生疏，这次帮助我摆脱了生疏感。 - Landen

2个回答

2

尝试使用Range.EntireRow.Value属性。

b.EntireRow.Value = SrchRng.EntireRow.Value

In

Do While SrchRng.Value <> ""
    If SrchRng.Value = "Unknown" Then
      b.EntireRow.Value = SrchRng.EntireRow.Value
    Set b = b.Offset(1, 0)
    Set SrchRng = SrchRng.Offset(1, 0)
    Else: Set SrchRng = SrchRng.Offset(1, 0)
    End If
Loop

- Ravi Yenugu

哇，这真是个很容易的解决方法！这是我一年来第一次接触 VBA，所以我忘记了这样的小技巧。谢谢！ - Landen

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Dan Wagner · Accepted Answer

考虑以下情况： Sheet 1中有一块数据，其中列G有“未知”条目，而Sheet 2为空。

通过将数据块定义为Range对象并应用识别“未知”条目的.Autofilter，我们可以将过滤后的结果简单地复制到Sheeet 2中。以下是详细注释的脚本：

Option Explicit
Sub CheckRowsWithAutofilter()

Dim DataBlock As Range, Dest As Range
Dim LastRow As Long, LastCol As Long
Dim SheetOne As Worksheet, SheetTwo As Worksheet

'set references up-front
Set SheetOne = ThisWorkbook.Worksheets("Sheet 1")
Set SheetTwo = ThisWorkbook.Worksheets("Sheet 2")
Set Dest = SheetTwo.Cells(1, 1) '<~ this is where we'll put the filtered data

'identify the "data block" range, which is where
'the rectangle of information that we'll apply
'.autofilter to
With SheetOne
    LastRow = .Range("G" & .Rows.Count).End(xlUp).Row
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
    Set DataBlock = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
End With

'apply the autofilter to column G (i.e. column 7)
With DataBlock
    .AutoFilter Field:=7, Criteria1:="=*Unknown*"
    'copy the still-visible cells to sheet 2
    .SpecialCells(xlCellTypeVisible).Copy Destination:=Dest
End With

'turn off the autofilter
With SheetOne
    .AutoFilterMode = False
    If .FilterMode = True Then .ShowAllData
End With

End Sub

这是在Sheet 2上的输出结果：

end