Excel 2007 VBA найти функцию. Попытка найти данные между двумя листами и поместить их на третий лист - PullRequest
0 голосов
/ 23 февраля 2011

Все,

Я пытаюсь написать макрос для поиска всех ячеек из столбца 2 с Листа 1 на Листе 2 и копирования найденных строк на Лист 2.

Вот что у меня получилосьfar:

Sub CopyUnique()
   Application.DisplayAlerts = False

   Set QA_14 = Sheets("QA 14Feb")
   Set Prod_14 = Sheets("Prod 14Feb")
   Set Prod_O14 = Sheets("Sheet1")
   Counter = 1

   Dim Found As Range
   Dim QARange As Range
   For Row = 1 To Prod_14.UsedRange.Rows.Count

       Set QARange = QA_14.Cells(2, 1)
       Set Found = QARange.Find(What:=Prod_14.Cells(Row, 2).Text, After:=QA_14.Range("A1"), LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

       If Not Found Is Nothing Then
            Prod_14.UsedRange.Range(Cells(Row, 1), Cells(Row, Prod_14.UsedRange.Columns.Count)).Copy Prod_O14.Range("A" & LTrim(Str(Counter)))

            Counter = Counter + 1
       End If

    Next

End Sub

Проблема возникает в строке с функцией Find.Просто выдает ошибку несоответствия типов.Я попытался разбить все переменные на отдельные строки, но они не являются частью проблемы.

Есть идеи?

Спасибо

Ответы [ 2 ]

1 голос
/ 24 февраля 2011

Параметр после , который вы используете, недопустим. Удалите его, и вы больше не получите ошибку несоответствия типов. Ответ на первый вопрос, и теперь у нас есть другой ... Я проверяю, как мы можем правильно установить это значение.

Я считаю, что, возможно, если вы дадите лучшее объяснение того, чего вы пытаетесь достичь, мы могли бы улучшить нашу помощь, предлагая предложения.

1007 * Rgds *

Edit:

Похоже, что После должен находиться в пределах диапазона поиска (и я считаю, что это не то, что вы хотите).

Этот код не вызывает ошибок, хотя я считаю, что не делает то, что вы хотите. Если вы дадите нам лучший пример того, что вам нужно, мы сможем помочь вам в дальнейшем.

совет № 1: В следующий раз при отправке кода я бы попросил вас также включить в ваш код объявление переменных, которые вы используете (вы используете Option Explicit , верно?). Особенно в Несоответствие типов ошибки, тип переменной может вызвать проблему.

tip # 2: Я бы посоветовал взглянуть на венгерскую нотацию.

Sub test()

    Dim qa_14 As Worksheet
    Dim prod_14 As Worksheet
    Dim prod_o14 As Worksheet
    Dim iCounter As Integer
    Dim iRow As Integer
    Dim rngAfter As Excel.Range
    Dim rngWhat As Excel.Range

    Dim Found As Range
    Dim QARange As Range

    Set qa_14 = Sheets("QA 14Feb")
    Set prod_14 = Sheets("Prod 14Feb")
    Set prod_o14 = Sheets("Sheet1")
    iCounter = 1

    For iRow = 1 To prod_14.UsedRange.Rows.Count

        Set QARange = qa_14.Cells(2, 1)

        Set rngAfter = QARange.Cells(1, 1)

        Set Found = QARange.Find(What:=prod_14.Cells(iRow, 2).Text, After:=rngAfter, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)

        If Not Found Is Nothing Then

            prod_14.UsedRange.Range(Cells(iRow, 1), Cells(iRow, prod_14.UsedRange.Columns.Count)).Copy prod_o14.Range("A" & LTrim(Str(iCounter)))

            iCounter = iCounter + 1

       End If

    Next

End Sub
0 голосов
/ 23 февраля 2011

Я думаю, что источником этой конкретной проблемы является то, что xlText не подходит для просмотра. Я считаю, что вам нужны xlValues ​​или xlFormulas.

Есть еще несколько вещей, которые следует учитывать. Лист1 не является хорошим именем переменной. Каждый лист имеет свойство CodeName, которое не изменяется при изменении имени вкладки листа. По умолчанию это CodeNames: Sheet1, Sheet2 и т. Д. Это может не вызывать проблемы, но, вероятно, лучше ее избегать.

В вас For Next вы увеличиваете Row на Sheet1.UsedRange.Count, который является числом ячеек в используемом диапазоне. Вы, вероятно, должны использовать

For Row = 1 to Sheet1.UsedRange.Rows.Count

Редактировать

Вот еще одна процедура, которая, я думаю, делает то, что вы хотите.

Sub CopyUnique()

    Dim shQa14 As Worksheet
    Dim shProd14 As Worksheet
    Dim shProdO14 As Worksheet
    Dim rCell As Range
    Dim rFound As Range

    Set shQa14 = Sheets("QA 14Feb")
    Set shProd14 = Sheets("Prod 14Feb")
    Set shProdO14 = Sheets("Sheet1")

    For Each rCell In Intersect(shProd14.UsedRange, shProd14.Columns(2)).Cells
        If Not IsEmpty(rCell.Value) Then
            Set rFound = shQa14.Cells.Find(rCell.Value, , xlValues, xlPart)

            If Not rFound Is Nothing Then
                Intersect(rFound.EntireRow, rFound.Parent.UsedRange).Copy _
                    shProdO14.Cells(shProdO14.Rows.Count, 1).End(xlUp).Offset(1, 0)
            End If
        End If
    Next rCell

End Sub

Я не задаю много параметров поиска, только те, которые мне нужны.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...