Excel VBA 宏找不到匹配项答案

【问题标题】：Excel VBA macros does not find matchesExcel VBA 宏找不到匹配项
【发布时间】：2015-12-09 16:30:40
【问题描述】：

我在 Excel 工作簿中设置了宏；其目标是： 1. 在 Sheet1 中，在表格中搜索列中的特定值。 2. 如果找到该值，则必须将整行复制到 Sheet2。

Sub procurarnegociacion()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 5
LSearchRow = 5

'Start copying data to row 3 in Sheet2 (row counter variable)
LCopyToRow = 3

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

    'If value in column W = 1, copy entire row to Sheet2
    If Range("W" & CStr(LSearchRow)).Value = "1" Then

        'Select row in Sheet1 to copy
        Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
        Selection.Copy

        'Paste row into Sheet2 in next row
        Sheets("Sheet2").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("Sheet1").Select

    End If

    LSearchRow = LSearchRow + 1


Wend

'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

MsgBox "All data copied."

Exit Sub

Err_Execute:
MsgBox "Error ocurred."

End Sub

但问题是：假设我搜索值“5”，而我在该列 W 中只有 1-5 个值。只有当我在表的开头将所有 5 排序（后代排序）时，该宏才有效。如果我在新月排序中有 W 列，所有 1 都在第一个，那么它不会将任何行复制到 Sheet2。它给出了消息所有数据已复制。”，但随后在 Sheet2 上没有复制任何行。

这是为什么呢？你能帮我解决这个问题吗？

【问题讨论】：

While Len(Range("A" & CStr(LSearchRow)).Value) > 0 您的循环正在测试是否可以在到达列底部之前结束？
findwindow，您认为您在评论中声明的那一行可能是问题的根源吗？我测试了 David Zemens 建议的版本，但是当我将 W 列以新月模式排序时，他的版本也不起作用。你能建议一个不同的方法来处理这个宏吗？
尝试使用将遍历整个列的 for 循环？

标签： excel vba visual-studio-macros

【解决方案1】：

这个稍微修改过的版本似乎对我有用，即使数据没有排序。您可能遇到范围限定问题，或者如果您在 Sheet2 处于活动状态时运行它，它可能无法按预期复制任何内容，等等。

Sub procurarnegociacion()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer
Dim source As Worksheet
Dim dest As Worksheet

On Error GoTo Err_Execute

Set source = Worksheets("Sheet1")   'Modify as needed
Set dest = Worksheets("Sheet2")     'Modify as needed

'Start search in row 5
LSearchRow = 5

'Start copying data to row 3 in Sheet2 (row counter variable)
LCopyToRow = 3

With source
    While Len(.Range("A" & CStr(LSearchRow)).Value) > 0

        'If value in column W = 1, copy entire row to Sheet2
        If .Range("W" & CStr(LSearchRow)).Value = "5" Then

            'Select row in Sheet1 to copy
            .Rows(LSearchRow).EntireRow.Copy _
                 Destination:=dest.Rows(LCopyToRow)

            'Move counter to next row
            LCopyToRow = LCopyToRow + 1
        End If

        LSearchRow = LSearchRow + 1
    Wend
    'Position on cell A3
    Application.CutCopyMode = False
    .Range("A3").Select
End With

MsgBox "All data copied."

Exit Sub

Err_Execute:
MsgBox "Error ocurred."

End Sub

【讨论】：