Question

我想使用工作表1中某个列（A1，A2，A3 ...）中的每个值/字符串，在工作表2中的某个范围中单独搜索该值/字符串，以及（！）并带有其他结尾。

示例：在工作表1中使用A1 = K-1234，并在工作表2的定义范围内搜索字符串K-1234以及K-1234与/ x，/ y，/ z的组合。只要找到这样的组合，就将工作表2的整个行复制到新工作表3中。

使用工作表1中的列A：

worksheet 1    

A

A1    = K-1234
A2    = Y-1234
A3    = RP-78
…
A1000 = Z/34-1

在工作表2中的B1：E3范围内搜索A1，A1 / x，A1 / y和A1 / z：

worksheet 2

A     B      C     D     E

GHJ   A1/x   456   G5G   F1-1
FF-   A1     23-A  TTR   BV1
8/a   A1/z   bnR   34-1  bn/1

使用工作表1中的A1在工作表2中进行搜索之后，工作表3的外观应如此：

worksheet 3

A     B     C      D      E 

FF-   A1    23-A   TTR   BV1
GHJ   A1/x  456    G5G    F1-1
8/a   A1/z  bnR    34-1   bn/1

或写出A1：

worksheet 3

A     B          C      D      E 

FF-   K-1234     23-A   TTR   BV1
GHJ   K-1234/x   456    G5G    F1-1
8/a   K-1234/z   bnR    34-1   bn/1

（A1 / y不存在）

继续使用A2，A2 / x，A2 / y和A2 / z等，直到列的末尾（例如A1000）。

希望我可以充分解释这个问题。我将非常感谢您的任何建议。

Answer 1

您可以尝试：

Option Explicit

Sub CopyYes()

    Dim i As Long, LastRow1 As Long, LastRow3 As Long
    Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
    Dim rngToSearch As Range, rngFound As Range

    With ThisWorkbook
        Set ws1 = .Worksheets("Sheet1")
        Set ws2 = .Worksheets("Sheet2")
        Set ws3 = .Worksheets("Sheet3")
    End With

    Set rngToSearch = ws2.Range("B1:E3")

    With ws1

        LastRow1 = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 1 To LastRow1

            Set rngFound = rngToSearch.Find(.Range("A" & i).Value & "*", LookIn:=xlValues)

            If Not rngFound Is Nothing Then

                LastRow3 = ws3.Cells(ws3.Rows.Count, "A").End(xlUp).Row

                If LastRow3 = 1 And ws3.Range("A1").Value = "" Then
                    LastRow3 = 1
                Else
                    LastRow3 = LastRow3 + 1
                End If

                ws2.Range("B" & rngFound.Row & ":E" & rngFound.Row).Copy
                ws3.Range("A" & LastRow3).PasteSpecial Paste:=xlPasteValues

            End If

        Next i

    End With

End Sub

在另一个工作表中搜索值/字符串和附加结尾

1 个答案: