Excel 2007 VBA 查找功能。尝试在两张纸之间查找数据并将其放入第三张纸中
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/5095801/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Excel 2007 VBA find function. Trying to find data between two sheets and put it in a third sheet
提问by Riz
All,
全部，
I am trying to write a macro to search all cells from column 2 from Sheet1 in Sheet2 and copy found rows to Sheet 2.
我正在尝试编写一个宏来搜索 Sheet2 中 Sheet1 中第 2 列的所有单元格，并将找到的行复制到 Sheet2。
This is what I have got so 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
The problem occurs on the line with Find function. Just gives a type mismatch error. I have tried splitting all variables to separate line but they're not part of problem.
问题发生在具有查找功能的线路上。只是给出了一个类型不匹配的错误。我尝试将所有变量拆分为单独的行，但它们不是问题的一部分。
Any ideas?
有任何想法吗？
Thanks
谢谢
回答by Tiago Cardoso
The afterparameter you're using is invalid. Remove it and you won't receive the type mismatch error anymore. First question answered, and now we have other... I'm checking how we can set this value properly.
您使用的after参数无效。删除它，您将不会再收到类型不匹配错误。第一个问题得到解答，现在我们还有其他问题……我正在检查如何正确设置这个值。
I believe that maybe if you give a better explanation of what you're trying to achieve we could improve our assistance giving suggestions.
我相信，如果您能更好地解释您要实现的目标，我们可以改进我们提供建议的帮助。
Rgds
Rgds
Edit:
编辑：
It seems that the Afterneeds to be within the range being searched (and I believe that's not what you want).
似乎After需要在被搜索的范围内（我相信这不是你想要的）。
This code does not raise errors, although I believe does not do what you want either. If you give us a better example of what you need, we may be able to help you further.
这段代码不会引发错误，尽管我相信也不会做你想要的。如果您给我们一个更好的例子来说明您的需求，我们或许能够为您提供进一步的帮助。
tip #1:Next time when submitting code, I'd ask you to also include in your code the declaration of the variables you're using (you're using Option Explicit, right?). Specially in Type Mismatcherrors, the variable type may cause the problem.
提示 #1：下次提交代码时，我会要求您在代码中也包含您正在使用的变量的声明（您正在使用Option Explicit，对吗？）。特别是在类型不匹配错误中，变量类型可能会导致问题。
tip #2:I'd suggest to take a look on Hungarian Notation.
提示#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
回答by Dick Kusleika
I think the source of that particular problem is that xlText isn't a valid option for lookin. I believe you need xlValues or xlFormulas.
我认为该特定问题的根源在于 xlText 不是查找的有效选项。我相信你需要 xlValues 或 xlFormulas。
There are a couple of other things to consider. Sheet1 is not a good variable name. Each sheet has a CodeName property that doesn't change when the sheet's tab name changes. By default, these CodeNames are Sheet1, Sheet2, etc. It may not cause a problem, but it's probably best to avoid it.
还有一些其他的事情需要考虑。Sheet1 不是一个好的变量名。每个工作表都有一个 CodeName 属性，当工作表的选项卡名称更改时，该属性不会更改。默认情况下，这些代码名称是 Sheet1、Sheet2 等。这可能不会导致问题，但最好避免它。
In you For Next, you increment Row by Sheet1.UsedRange.Count, which is a count of the number of cells in the used range. You should probably use
在 For Next 中，您通过 Sheet1.UsedRange.Count 增加 Row，这是已使用范围内单元格数量的计数。你可能应该使用
For Row = 1 to Sheet1.UsedRange.Rows.Count
Edit
编辑
Here's another procedure that I think does what you want.
这是我认为可以满足您要求的另一个程序。
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
I don't specify a lot of the Find parameters, only ones I care about.
我没有指定很多 Find 参数，只指定我关心的参数。
