如何在Excel中进行部分查找并在下一列中获取数据直到VBA中的四行

Question

我有工作表1的列名：主要任务

主要任务

而且，我有工作表2 ，其中根据主要任务中数据的第一和第二连字符（-）之间的字符给出子 任务 ，例如：在主要任务列下有“ 金字塔-IoT预测-拉丁美洲-阿根廷-2017年 。 因此，基于字符串“ IoT Forecast ”，如下图所示给出了子任务。

输出：

现在在工作表3中，我需要从工作表1中复制并粘贴主要任务中的每个标题，并寻找相关的子任务并粘贴在下一列中，如下图所示。

我曾经使用过通配符，使用Mid Function进行部分V型查找，但是只填充了一个子任务。 请帮助我在VBA中提供代码。

Answer 1

工作表3与工作表2相同，但其中包含完整的主要任务，而不仅仅是摘要。 我建议采用以下方法。

1. 在工作表1中创建一列，其中仅编写摘录。 此列的内容将与工作表2的A列相同。使用此公式填充该列（其中A2包含完整的主要任务）。

   TRIM =（LEFT（MID（$ A2，FIND（ “ - ”，$ A2）1100），FIND（ “ - ”，MID（$ A2，FIND（ “ - ”，$ A2）1100）） - 1） ）

2. 复制工作表2作为工作表3，并在其中添加空白列B。 用此公式填充此列（其中A：A是包含完整任务的列，C：C是您在步骤1中添加的列。

   = INDEX（'Sheet 1'！A：A，MATCH（A2，'Sheet 1'！C：C，0））

3. 用值（“复制/粘贴”值）替换工作表3中的公式，然后从该工作表中删除列A。 将此工作表按现在的A列排序。

4. 删除您在工作表1中添加的列，以将工作表1恢复到其原始状态。

Answer 2

您将需要做一个数组公式，类似于下面的内容，其中子类别位于C1中

=INDEX($A$2:$A$6,SMALL(IF(NOT(ISERROR(SEARCH("-" & $C$1 & "-",$A$2:$A$6))),ROW($A$2:$A$6)-1),ROWS($D$1:D1)))

Answer 3

如果您愿意接受VBA解决方案，则可以尝试这样的操作。 下面的代码假定工作簿中有三个工作表，分别为“ Sheet1”，“ Sheet2”和“ Sheet3”。

如果原始工作簿中的工作表名称不同，请在测试代码之前在以下行的代码中进行更改。

Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")

将以下代码放在标准模块上，然后运行代码以在Sheet3上获得所需的输出。

Sub LookupData()
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim rng As Range, cell As Range, MainTask As Range
Dim lr2 As Long, lr3 As Long
Dim MainTaskStr As String, wht As String
Application.ScreenUpdating = False
Set ws1 = Sheets("Sheet1")
Set ws2 = Sheets("Sheet2")
Set ws3 = Sheets("Sheet3")
lr2 = ws2.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ws2.Range("A2:A" & lr2)

ws3.Cells.Clear
ws3.Range("A1:B1").Value = Array("Main Task", "Sub-Task")

If ws2.FilterMode Then ws2.ShowAllData

For Each cell In rng
    If cell.Value <> MainTaskStr Then
        MainTaskStr = cell.Value
        lr3 = ws3.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
        wht = "- " & cell.Value & " -"
        Set MainTask = ws1.Range("A:A").Find(what:=wht, LookIn:=xlValues, lookat:=xlPart, MatchCase:=False)
        If Not MainTask Is Nothing Then
            With ws2.Rows(1)
                .AutoFilter field:=1, Criteria1:=MainTaskStr
                ws3.Range("A" & lr3) = MainTask.Value
                ws2.Range("B2:B" & lr2).SpecialCells(xlCellTypeVisible).Copy ws3.Range("B" & lr3)
            End With
        End If
    End If
Next cell

If ws2.FilterMode Then ws2.AutoFilterMode = False

ws3.UsedRange.Columns.AutoFit

Application.ScreenUpdating = True
End Sub