在vba中查找具有共同值的单元格

我正在尝试编写一个macros，它将循环遍历一列，并取出每个单元格，并find所有其他近似匹配的单元格，并将它们移动到另一个电子表格。 我想使用find方法，但我不确定如何实现它。 我粘贴了迄今为止所做的，这并不多。 我很新vba，所以任何帮助将不胜感激。

Sub Extract() Dim i As Long, count As Long, rng1 As Range Set rng1 = Sheet1.Range(Range("N1"), Range("N1").End(xlDown)) count = 2 For i = 1 To Sheet1.Range(Range("N1"), Range("N1").End(xlDown)).Rows.count Sheet1.Cells(count, 14).Select count = count + 1 Next i End Sub 

Answer 1

这是一个简单的解决scheme，让你去。 因为像searchstring，search栏，工作表等东西都是硬编码的。 “匹配”被放置在一个名为“匹配”的工作表中与“数据”表（Col A）位于同一个“位置”，并从中提取出来。

 Sub findlikes() Dim wsDat As Worksheet, wsMat As Worksheet Dim strSearch As String, firstAdd As String Dim fndCell As Range Dim srchCol As Long, numFnd As Long Set wsDat = Sheets("Data") Set wsMat = Sheets("Matches") srchCol = 1 'Col A strSearch = "Alka-Seltzer" Set fndCell = wsDat.Columns(srchCol).Find(What:=strSearch, LookIn:=xlValues, _ LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If Not fndCell Is Nothing Then firstAdd = fndCell.Address numFnd = 1 Do wsMat.Range(fndCell.Address).Value = fndCell.Value Set fndCell = wsDat.Columns(srchCol).FindNext(fndCell) numFnd = numFnd + 1 Loop While Not fndCell Is Nothing And fndCell.Address <> firstAdd Else MsgBox "Search String Not Found" End If End Sub 

这种方法使用您在原始文章中提到的F​​ind（和FindNext）方法。

在这里和这里可以find对这些的进一步参考。