Question

我正在尝试编写一个宏，它将遍历一个列并获取每个单元格并查找所有其他大致匹配的单元格并将它们移动到另一个电子表格。我想过使用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

这是一个让您前进的简单解决方案。因为搜索字符串，搜索列，工作表等内容都是硬编码的。＆＃39;匹配＆＃39;被放置在名为“匹配”的工作表中。在相同的位置＆＃39;作为＆＃39;数据＆＃39;从中提取它们的表（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

此方法使用您在原始帖子中提到的Find（和FindNext）方法。

可以在here和here找到对这些内容的进一步参考。

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

1 个答案: