Макрос Excel: условное вырезание и вставка между книгами - PullRequest
Новая
       13

Макрос Excel: условное вырезание и вставка между книгами

0 голосов
/ 29 августа 2011

Итак, я хочу, чтобы в файле Excel ("input.xls") выполнялся макрос, который ищет столбец в другом файле Excel ("data.xls") для значения "1" (единственными значениями в этих столбцах являются 1 и 0). Когда он находит «1», он должен скопировать и вставить всю строку из этого файла в «input.xls».

Вот код, который у меня есть 

Sub NonErrorDataParse()
    Dim intEnd As Integer

    Workbooks("data.xls").Sheets("Raw").Activate

    intEnd = 65000

    Range("F").Select

    Do Until ActiveCell.Row = intEnd

        If Int(ActiveCell.Value) = 1 Then
            Range(ActiveCell.Row & ":" & ActiveCell.Row).Cut
            intEnd = intEnd - 1
            Workbooks("input.xls").Sheets("Non-errors").Activate
            Range("A1").Select
            ActiveSheet.Paste
        Else
            ActiveCell.Offset(1, 0).Select
        End If

    Loop

End Sub

Тем не менее, когда я запускаю его, он выдает мне ошибку «индекс вне диапазона» в «data.xls». Независимо от того, как я работаю с кодом, я не могу обойти эту ошибку (хотя у меня есть ДРУГИЕ макросы, которые обращаются к этому листу, которые работают нормально).

Есть идеи, как это исправить? Или лучший код, который будет делать то же самое?

Заранее спасибо

1 Ответ

0 голосов
/ 29 августа 2011

Вам не нужно Select или Activate каждый раз, когда вы выполняете команду.
Вы также можете найти последнюю использованную ячейку с помощью Range("A65536").End(xlup) вместо анализа каждой ячейки (что, вероятно, вызвало вашу ошибку).

Код будет выглядеть следующим образом: 

Sub NonErrorDataParse()
    Dim intEnd As Integer
    Dim c As Range

    intEnd = Workbooks("data.xls").Sheets("Raw").Range("A65536").End(xlUp).Row

    For Each c In Workbooks("data.xls").Sheets("Raw").Range("F1:F" & intEnd)
       If CStr(c.Value) = "1" Then
           c.EntireRow.Cut
           Workbooks("input.xls").Sheets("Non-errors").Rows("1:1").Insert Shift:=xlDown
       End If
    Next c
End Sub

Тем не менее, если у вас много строк, будет быстрее использовать метод autofilter или словарь.

...