Excelmacros多行查找条件并插入

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

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

你可以使用下面的代码，我已经testing你提供的testing用例，它的工作正常。

 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 

编辑代码写入第一行，如果没有select工作。

Answer 2

尝试：

 Sub test() Dim colNum As Long colNum = ActiveSheet.Rows(1).Find(What:="Range", LookAt:=xlWhole).Column ActiveSheet.Columns(colNum + 1).Insert ActiveSheet.Cells(1, colNum + 1).Value = "NEW" Dim Arr As Variant Dim Lr As Long, R As Long Dim i As Long, n As Long Dim V As String, F As String Lr = Cells(Rows.Count, colNum).End(xlUp).Row Arr = Array("DS", "FP", "NP", "HE") For R = 2 To Lr V = Cells(R, colNum).Value For i = 0 To UBound(Arr) n = InStr(V, Arr(i)) If n <> 0 Then F = Mid(V, n) If InStr(F, vbLf) <> 0 Then F = Split(F, vbLf)(0) Cells(R, colNum + 1).Value = F Exit For End If Next Next End Sub