If和Loop函数提取数据 [英] If and Loop function to extract data

问题描述

在上面的示例数据集中，我尝试使用VBA的 If 函数查找特定的关键字，如果存在匹配项，我想提取名称本身以及其序列号数字和乘积，然后添加到同一工作簿中另一工作表的最后一行.

In the sample dataset above, I am trying to use the VBA's If function to look for a specific keyword, and if there's a match, I would want to extract the Name itself, alongside its Serial Number and Product, and add to the last row of another worksheet, within the same workbook.

例如，在C列中的如果，我们检测到例如 cana (请注意，这不是完全匹配，但足够好了)，那么我想VBA可以帮助我提取金丝雀码头，其旁边的序列号和产品，它们分别是 8273615 和罐头食品，移至另一个工作表的末尾，循环一直进行到金丝雀码头结束，然后移至Riverdale，我将其键入为 riverd ，并重复相同的过程.x表示我有一个相当大的数据集，没别的.

For instance, If in column C, we detect, say, cana (note that this is not an exact match, but good enough), then I would want VBA to help me to extract Canary Wharf, its Serial Number and Product next to it, which are 8273615 and Canned Food, to the end of another worksheet, and the loop goes on until the end of Canary Wharf and moves on to Riverdale, which I would type, say, riverd, and repeat the same process. The x's are there to signify that I have a rather large dataset, nothing else.

在使用如果单元格包含在VBA excel 中，它有很大的帮助，但是我做不到确切的事情.任何帮助将不胜感激！

I have gotten some clues with the top answer found in Using "If cell contains" in VBA excel , it is of great help, but I could not quite get the exact thing to do. Any help would be very much appreciated!

下面应该是直觉:

Option Compare Text

Sub DataExtraction()

Dim SrchRng As Range, cel As Range
Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")


Set SrchRng = ws1.Range("C:C")

For Each cel In SrchRng
    If InStr(1, cel.Value, "cana") > 0 Then
        ActiveCell.Value = "Canary Wharf"

    End If
Next cel

End Sub

通过使用上面的代码，我设法使ActiveCell.Value成为Canary Wharf，但是，我需要循环执行代码，直到不再有Canary Wharf为止，同时还将两个输入复制到它的权利.

By using the code above, I managed to get the ActiveCell.Value to become Canary Wharf, however, I need the code to loop until there are no more Canary Wharf's, and at the same time, also copy the two inputs to its right.

推荐答案

您可以执行以下操作:

Option Compare Text

Sub DataExtraction()

    Dim SrchRng As Range, cel As Range, rngDest as Range
    Dim ws1 As Worksheet, ws2 As Worksheet

    Set ws1 = Worksheets("Sheet1")
    Set ws2 = Worksheets("Sheet2")

    'restrict the search range
    Set SrchRng = Application.Intersect(ws1.Range("C:C"), ws.UsedRange)

    Set rngDest = ws2.cells(rows.count, 1).end(xlUp).Offset(1, 0) 'start copy here

    For Each cel In SrchRng.Cells
        If InStr(1, cel.Value, "cana") > 0 Then
            rngDest.Value = "Canary Wharf"
            rngDest.offset(0, 1).value = cel.offset(0, 1).value
            rngDest.offset(0, 2).value = cel.offset(0, 2).value
            Set rngDest = rngDest.offset(1, 0) '<< next row down
        End If
    Next cel

End Sub

这篇关于If和Loop函数提取数据的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！