vba - Excel 宏多行查找条件并插入

Question

我有一个 Excelsheet 列“范围”，其中有随机顺序的多行文本。我需要在多行文本中找到特定前缀并将其粘贴到下一列。

目标是按 DS>FP>NP>HE 等顺序查找前缀，其中如果 DS 前缀不存在，则采用 FP 等。

示例表结果如下所示:-

到目前为止我有以下代码，请帮我解决这个作业:-

Sub Rangess()

   Dim colNum As Integer
   colNum = ActiveSheet.rows(1).Find(What:="Range", LookAt:=xlWhole).Column
    ActiveSheet.Columns(colNum + 1).Insert
    ActiveSheet.Cells(1, colNum + 1).Value = "NEW"

End Sub

Answer 1

您可以使用下面的代码，我已经在您提供的测试用例上进行了测试，并且它工作正常。

Sub Test()
    Dim colNum As Integer
    colNum = ActiveSheet.Rows(1).Find(What:="Range", LookAt:=xlWhole).Column
    ActiveSheet.Columns(colNum + 1).Insert
    ActiveSheet.Cells(1, colNum + 1).Value = "NEW"

    'counting no of rows
    Dim No_Of_Rows As Long
    No_Of_Rows = ActiveSheet.UsedRange.Rows.Count

    Dim Range_col_val As Variant
    Dim split_Range_col As Variant
    Dim Range_splited_cell_val As Variant
    Dim Prefix As Variant
        Prefix = Array("DS", "FP", "NP", "HE")
    Dim FLAG As Boolean
    Dim j As Integer



    'Looping for rows

    For i = 2 To No_Of_Rows

        'Extracting Data from col Range

        Range_col_val = Cells(i, colNum).Value
        split_Range_col = Split(Range_col_val, vbLf)
        j = 0
        ActiveSheet.Cells(i, colNum + 1).Value = split_Range_col(0)
        FLAG = False
        While FLAG = False And j < 5
            'Looping for Each Line in Col Range
            For k = LBound(split_Range_col) To UBound(split_Range_col)
                Range_splited_cell_val = split_Range_col(k)
                If (Range_splited_cell_val Like Prefix(j) & "*") Then
                    ActiveSheet.Cells(i, colNum + 1).Value = Range_splited_cell_val
                    FLAG = True
                End If
            Next k
            j = j + 1
        Wend
    Next i
End Sub

如果所有选择都不起作用，则编辑代码以编写第一行。