Vba Excel宏多行查找条件和插入

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

目的是按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

尝试：

子测试（）
淡色秋千一样长
colNum=ActiveSheet.Rows（1）.Find（What:=“Range”，LookAt:=xlother）.列
ActiveSheet.Columns（colNum+1）.Insert
ActiveSheet.Cells（1，colNum+1）.Value=“新建”
作为变体的Dim-Arr
变暗左半身长，右半身长
暗淡的i一样长，n一样长
尺寸V为字符串，F为字符串
Lr=单元格（Rows.Count，colNum）.End（xlUp）.Row
Arr=数组（“DS”、“FP”、“NP”、“HE”）
对于R=2至Lr
V=单元格（R，colNum）.Value
对于i=0至UBound（Arr）
n=仪表（V，Arr（i））
如果n0那么
F=中间（V，n）
如果InStr（F，vbLf）为0，则F=Split（F，vbLf）（0）
单元格（R，colNum+1）。值=F
退出
如果结束
下一个
下一个
端接头

您可以使用下面的代码，我已经在您提供的测试用例上测试了这些代码，并且运行良好

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

子测试（）
Dim colNum作为整数
colNum=ActiveSheet.Rows（1）.Find（What:=“Range”，LookAt:=xlother）.列
ActiveSheet.Columns（colNum+1）.Insert
ActiveSheet.Cells（1，colNum+1）.Value=“新建”
“数行数
变暗的行数不超过
行数=ActiveSheet.UsedRange.Rows.Count
变光范围
变型尺寸分割范围颜色
变暗范围\u分割的\u单元\u值作为变量
作为变体的Dim前缀
前缀=数组（“DS”、“FP”、“NP”、“HE”）
将标志变暗为布尔值
作为整数的Dim j
“行循环
对于i=2到无行数
'从列范围提取数据
Range\u col\u val=单元格（i，colNum）.Value
split\u Range\u col=split（Range\u col\u val，vbLf）
j=0
ActiveSheet.Cells（i，colNum+1）.Value=split\u Range\u col（0）
FLAG=False
而FLAG=False且j<5
'列范围内每行的循环
对于k=LBound（分割范围列）到UBound（分割范围列）
范围分割单元格值=分割范围列（k）
如果（像前缀（j）和“*”）一样的范围分割单元格值，则
ActiveSheet.Cells（i，colNum+1）.Value=Range\u splited\u cell\u val
FLAG=True
如果结束
下一个k
j=j+1
温德
接下来我
端接头

---

编辑代码以写入第1行（如果所有选择均无效）

您可以使用“拆分”来分隔多行文字，并使用“左”来获取前两个字母。要查找前缀，可以使用选择。。。如果您愿意，可以使用Case函数或多if语句。谢谢matts，我是宏制作的新手，您能帮助我吗，但请自己研究并尝试编写代码。感谢mohit，如果我的选择没有出现在多行文字中，我希望第一行粘贴到新的列中，该怎么办？我已编辑了上面的代码，仅此而已。您只需在开始处设置第一行，这样，如果找到匹配项，则列值将更改，否则会更改将是RangeThank Fadi中的第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