Question

我有两个工作表：

工作表1 有两列：A＆amp; B.

ColA包含大约10,000个单元格，每个单元格仅包含文本句子。每个细胞长度不超过50个字。
ColB包含ColA中每个单元格的唯一文本标签。

工作表2 有一列ColA，其中包含超过18,000个单词。

所需要的是使用Worksheet2的ColA中的每个单词并在Worksheet1的ColA中找到它，然后从ColB Worksheet1中检索其标签或多个标签，为第三个Worksheet3中搜索的每个单词分组。

例如：
Worksheet1：
ColA ColB
Case four adjourned till Jan2011 FG_Suya
Item four modified permanently SH84-Mindus

工作表2：
ColA
case
four
item
item four modified

Worksheet3 :(运行请求的代码后）
ColA ColB
Case FG_Suya
four FG_Suya
_ SH84-Mindus
item SH84-Mindus

此link处的代码非常有用，但需要对其进行修改以适应查找搜索单词的多个实例，并对每个搜索单词的发现进行分组，并将其放入第三个工作表中。

对此事的协助表示高度赞赏。提前谢谢。

Answer 1

这里有一个如何开始考虑它的样本。代码不使用Range.Find方法，但它使用Range.Value作为数组。因此搜索运行得更快，然后循环Range.Cells。如果你要测试它，那么我建议首先采取少量数据:-)。 HTH。

Option Explicit

Private Const TextsSheetName As String = "Worksheet1"
Private Const WordsSheetName As String = "Worksheet2"
Private Const ResultsSheetName As String = "Worksheet3"

Private m_textsSheet As Worksheet
Private m_wordsSheet As Worksheet
Private m_resultsSheet As Worksheet

Private m_texts() As Variant
Private m_words() As Variant

Sub JosefMiller()
    Set m_textsSheet = Worksheets(TextsSheetName)
    Set m_wordsSheet = Worksheets(WordsSheetName)
    Set m_resultsSheet = Worksheets(ResultsSheetName)

    m_texts = m_textsSheet.UsedRange
    m_words = m_wordsSheet.UsedRange

    Dim w As Long
    Dim t As Long
    Dim r As Long
    Dim foundThisWord As Boolean

    For w = LBound(m_words) To UBound(m_words)
        foundThisWord = False
        For t = LBound(m_texts) To UBound(m_texts)
            If (InStr(1, m_texts(t, 1), m_words(w, 1), vbTextCompare) > 0) Then
                r = r + 1
                If Not foundThisWord Then
                    m_resultsSheet.Range("A" & r) = m_words(w, 1)
                Else
                    m_resultsSheet.Range("A" & r) = "_"
                End If
                m_resultsSheet.Range("B" & r) = m_texts(t, 2)
                foundThisWord = True
            End If
        Next t
    Next w
End Sub

对于WorkSheet3中的示例数据，您应该看到：

case                FG_Suya
four                FG_Suya
_                   SH84-Mindus
item                SH84-Mindus
item four modified  SH84-Mindus

多次查找和分组结果

1 个答案: