Question

所有

我正在尝试编写一个宏来搜索Sheet2中Sheet1的第2列中的所有单元格，并将找到的行复制到Sheet 2。

这是我到目前为止所得到的：

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函数的行上。只是给出了类型不匹配错误。我已经尝试将所有变量拆分为单独的行，但它们不是问题的一部分。

有什么想法吗？

由于

Answer 1

您使用的参数后无效。删除它，您将不再收到类型不匹配错误。第一个问题回答了，现在我们还有其他......我正在检查如何正确设置这个值。

我相信，如果你对你想要达到的目标做出更好的解释，我们可以改善我们提供建议的帮助。

RGDS

编辑：

似乎 After 需要在搜索范围内（我相信这不是你想要的）。

此代码不会引发错误，但我相信也不会出现您想要的错误。如果您给我们一个更好的例子，我们可以帮助您。

提示＃1：下次提交代码时，我会要求您在代码中包含您正在使用的变量的声明（您正在使用 Option Explicit ，对吧？）特别是在 Type Mismatch 错误中，变量类型可能会导致问题。

提示＃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

Answer 2

我认为该特定问题的根源是xlText不是lookin的有效选项。我相信你需要xlValues或xlFormulas。

还有其他一些事情需要考虑。 Sheet1不是一个好的变量名。每个工作表都有一个CodeName属性，当工作表的选项卡名称更改时，该属性不会更改。默认情况下，这些CodeNames是Sheet1，Sheet2等。它可能不会导致问题，但最好避免它。

在“您的下一步”中，您将按Sheet1.UsedRange.Count递增Row，这是使用范围中的单元格数的计数。你应该使用

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

我没有指定很多Find参数，只有我关心的那些。

Excel 2007 VBA查找功能。试图在两张纸之间找到数据并将其放在第三张纸上

2 个答案: