Excel VBA宏找不到匹配项

时间:2015-12-09 16:30:40

标签: excel vba visual-studio-macros

我在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上没有复制任何行。

为什么? 你能帮我解决这个问题吗?

1 个答案:

答案 0 :(得分:0)

这个稍微修改过的版本似乎对我有用,即使数据没有排序。您可能遇到范围限定问题,或者如果您在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