0

我需要在某些地方合并的列中搜索特定单词，如果存在，我需要复制也合并的行并将其粘贴到不同的工作表上。
下面的代码我只使用复制和粘贴包含单词的第一个合并行，然后它给我一个错误。它应该遍历整个工作表并复制包含该单词的所有行。

我已经评论了我的代码，所以它更容易理解。

Sub SearchForString()
    Dim LSearchRow As Integer
    Dim LCopyToRow As Integer

    On Error GoTo Err_Execute
    'Start search in row 10
    LSearchRow = 11
    'Start copying data to row 1 in Sheet12 (row counter variable)
    LCopyToRow = 1
    While Len(Range("A" & CStr(LSearchRow)).Value) <> Null
        'If value in column E = "ENGINE AUXILIARY PANEL (EAP 1)", copy entire row to Sheet12
        If Range("E" & CStr(LSearchRow)).Value = "13.8kV SWITCHGEAR METERING CELL #A1 (+06)" Then
            'Select row in Sheet1 to copy
            Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
            Selection.Copy
            'Paste row into Sheet2 in next row
            Sheets("Sheet14").Select
            Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste
            'Move counter to next row
            LCopyToRow = LCopyToRow + 1
            'Go back to Sheet1 to continue searching
            Sheets("Sheet11").Select
        End If
        LSearchRow = LSearchRow + 1
    Wend
Exit Sub

Err_Execute:
4

2 回答 2

0

查看您的代码，我看不出为什么会产生错误。但是，您绝对应该替换<> Null为<> 0，否则您将永远不会进入循环（因为Len将始终返回一个数字，因此永远不会为 NULL）。

但是，我认为您可以使用另一种方法显着优化您的代码 - 只需使用自动过滤器来过滤您的搜索词，然后复制所有可见的行。这样做（并使用一些其他 VBA 快捷方式），我最终得到了 4 条指令：

Sub nextVersion()
    Dim rngAll As Range

    With Worksheets("Sheet11")
        Set rngAll = .Range("A1").Resize( _
            .Cells(Rows.Count, 1).End(xlUp).Row, 5)
        rngAll.AutoFilter Field:=5, Criteria1:= _
            "13.8kV SWITCHGEAR METERING CELL #A1 (+06)"
        If rngAll.SpecialCells(xlCellTypeVisible).Columns.Count > 1 Then
            rngAll.Offset(1).Resize(rngAll.Rows.Count - 1). _
                SpecialCells(xlCellTypeVisible).EntireRow.Copy _
                Worksheets("Sheet14").Range("1:1")
        End If
        rngAll.AutoFilter
    End With
End Sub

更新 鉴于您已合并数据中的单元格，自动筛选解决方案将不起作用。这应该做的工作：

Sub CopyRows()
    Dim rng As Range
    Dim lngRows As Long
    Dim lngTargetRow As Long
    Dim lngRowsToCopy As Long

    Set rng = Sheet11.Range("E11")
    lngTargetRow = 0
    lngRows = Sheet11.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    Worksheets("Sheet14").UsedRange.Clear

    While rng.Row < lngRows
        lngRowsToCopy = rng.MergeArea.Rows.Count
        If rng.Value = "13.8kV SWITCHGEAR METERING CELL #A1 (+06)" Then
            rng.MergeArea.EntireRow.Copy _
                Worksheets("Sheet14").Range("A1").Resize(lngRowsToCopy).Offset(lngTargetRow).EntireRow
            lngTargetRow = lngTargetRow + lngRowsToCopy
        End If
        Set rng = rng.Offset(1)
    Wend

End Sub
于 2013-02-21T23:14:04.533 回答
-1 
{
Sub FindTheFeret()
With Worksheets(1).Cells
Set c = .Find("Feret", LookIn:=xlValues)
i = 1
If Not c Is Nothing Then
    firstAddress = c.Address
    Do
        c.EntireRow.Copy
        Worksheets(2).Rows(i).EntireRow.PasteSpecial
        i = i + 1
        Set c = .FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub
}
于 2013-07-30T15:44:16.483 回答